User Define Array Data Type - Subscript out of range

  • Thread starter Thread starter PatK
  • Start date Start date
P

PatK

Hi! I am making my first foray into arrays and am running into a problem.
WHen I run this code, I am getting an error: Runtime Error 9, subscript out
of range (I have noted the point where DEBUG is pointing to the error. Is
the problem my user defined datatype? Do I have to "ReDim" the array
somehow, inside the subroutine?
ARGGGG...! Help

Thanks! PatK




Option Compare Database
Type dtype
strNameIn() As String
IntInputOrder() As Integer
strDataType() As String
strNameOut() As String
IntMaxLen() As Integer
intOutputOrder() As Integer
strDataSrcTbl() As String
strDataSrcFld() As String
End Type
------------------------------------------------------------------------
Sub xformData()

Dim xArray As dtype
Dim rs As ADODB.Recordset
Dim strSelect As String
Dim strDTypein As String
Dim strOutTbl As String
Dim strYourDB As String
Dim i As Integer

strDTypein = "EVOpen"
strOutTbl = "Tbl-Tickets"
strSelect = "DataType='" & strDTypein & "'"

Set rs = New ADODB.Recordset
With rs
.Open "TblStructure", CurrentProject.Connection, adOpenStatic, _
adLockPessimistic
.MoveFirst
.Find strSelect
i = 0
Debug.Print strSelect;
Do Until .EOF
Debug.Print i; <- this is equal to zero on first/failing loop
xArray.strNameIn(i) = rs.Fields("FieldName-Input") <- Getting error
here
xArray.strDataType(i) = rs.Fields("FieldType")
MsgBox "Fieldname: " & xArray.strNameIn(i) & " DataType: " & _
xArray.strDataType(i)
i = i + 1
.Find strSelect, 1
Loop
End With
rs.Close
Set rs = Nothing
End Sub
 
At some point before you actually start using the array, yes, you have to
ReDim it. The most efficient way is normally to find out how many elements
you need (using .RecordCount, presumably), ReDim the arrays, then move into
your loop.

A less-efficient, but sometimes-necessary way, is to ReDim the array to be
one larger than it used to be on each iteration. To do that, you also have
to use the Preserve keyword, so...

ReDim Preserve xArray.strNameIn(UBound(xArray.strNameIn) + 1)

You would have to do that for each element.

The other way to approach it would be to make the various members of dtype
to standard datatypes (i.e., not arrays), then make an array of dtype
instead of having different arrays within it.


Rob
 
You have not given the array any dimensions. Also, I don't believe you can
dim an array using a Type. You would dimension the array so it would have
enough columns to handle your fields.

The trick here is that because you don't know how many records there will be
in the recordset, you can't accurately define the number of rows. The way
around that would be to define a dynamic array, sort of like you are doing,
Dim xArray() As Variant

Then, after you open the recordset, get the recordset's RecordCount and use
the Redim statement to size it correctly:

Redim xArray(rs.RecordCount -1, 7)
 
Both of these suggestions are good. I eventually figured it out by trial and
error, using this adjustment to the loop code, as you noted Robert (so, glad
we came to the same conclusion, altho, now, admittedly, perhaps not the best
approach. Here is just the tweeked loop section:

With rs
.Open "TblStructure", CurrentProject.Connection, adOpenStatic, _
adLockPessimistic
.MoveFirst
.Find strSelect
i = 0
j = 0

Do Until .EOF
'-----------------------------------------------------
'upsize the array to accomodate incoming data'
'-----------------------------------------------------
ReDim Preserve xArray.strNameIn(i)
ReDim Preserve xArray.IntInputOrder(i)
ReDim Preserve xArray.strDataType(i)
ReDim Preserve xArray.strNameOut(i)
ReDim Preserve xArray.IntMaxLen(i)
ReDim Preserve xArray.intOutputOrder(i)
ReDim Preserve xArray.strDataSrcTbl(i)
ReDim Preserve xArray.strDataSrcFld(i)
'-----------------------------------------------------
' Load Array
'-----------------------------------------------------
xArray.strNameIn(i) = rs.Fields("FieldName-Input")
xArray.IntInputOrder(i) = rs.Fields("FieldInputOrder")
xArray.strDataType(i) = rs.Fields("FieldType")
xArray.strNameOut(i) = rs.Fields("FieldName-Output")
xArray.IntMaxLen(i) = rs.Fields("FieldMaxLen")
xArray.intOutputOrder(i) = rs.Fields("FieldOutputOrder")
xArray.strDataSrcTbl(i) = rs.Fields("CalcSourceTbl")
xArray.strDataSrcFld(i) = rs.Fields("CalcSourceField")
i = i + 1
.Find strSelect, 1
Loop
End With

WHile this worked, as you both noted, I am thinking there must be a better
way to accomplish what I am trying to do, name, use a table "mapping" array
to load data from one table, into another...this is just the
beginning...loading an array with the parameters to map data from one table
to another. Eventually, I will actually start "adding" new rows based upon
data from one table, pushing it into another, but in a different layout/field
names.

I just want to read the mapping table, which says, this data from table X,
field Y, goes to Table A, field B (with a possible data type change, as, for
example, some date fields are coming in as text, vs dates). Eventually, I
will be loading data from about a dozen different "input" tables, and
transforming it on the way to a new, consolidated "output" table.

Anyway, I truly appreciate the insights. I just need to figure out how I
want to do this. And I think Arrays may play a role, at least for the
mapping info, that can change, per load.

PatK
 
The absolute fastest way to do what you want would be to use SQL statements
instead of looping code, but that would, of course, depend on what all you
need to do. So for now, I'll assume that doing all this through code will
be necessary at some point, and that your current algorithm makes sense for
what you ultimately need to do.

Given that, here are a couple of modifications I would make to your code.
My comments are out-dented; also watch out for line wrapping, but I assume
that'll be obvious:

Type dtype
strNameIn As String
IntInputOrder As Integer
strDataType As String
strNameOut As String
IntMaxLen As Integer
intOutputOrder As Integer
strDataSrcTbl As String
strDataSrcFld As String
End Type

Dim xArray() As dtype

With rs
.Open "SELECT * FROM TblStructure WHERE " & strSelect,
CurrentProject.Connection, adOpenStatic, adLockPessimistic, adCmdText
'Changing the SQL statement do do the work on the front end will
'save a lot of time compared to doing multiple .Find's.
.MoveLast
'Makes the .RecordCount accurate
'-----------------------------------------------------
'upsize the array to accomodate incoming data'
'-----------------------------------------------------

i = UBound(xArray)
'Assumes xArray is already used from a previous instance of this code.
'If not, then simply put i = -1

'Re-Dim for the entire recordset all at once...saves a LOT of time.
'This is, however, predicated on the idea that you can bump strSelect
'up to the WHERE clause, as I've done above.
ReDim Preserve xArray(.RecordCount + i)

j = 0
'What's j for?

.MoveFirst
Do Until .EOF
i = i + 1
'Moved up here to pre-increment, which is easier to manage in this instance.

'-----------------------------------------------------
' Load Array
'-----------------------------------------------------
xArray(i).strNameIn = ![FieldName-Input].Value
xArray(i).IntInputOrder = !FieldInputOrder.Value
xArray(i).strDataType = !FieldType.Value
xArray(i).strNameOut = ![FieldName-Output].Value
xArray(i).IntMaxLen = !FieldMaxLen.Value
xArray(i).intOutputOrder = !FieldOutputOrder.Value
xArray(i).strDataSrcTbl = !CalcSourceTbl.Value
xArray(i).strDataSrcFld = !CalcSourceField.Value
.MoveNext
Loop
End With



Rob
 
Thanks...I am going to make these changes. I will let you know how it goes.
It may solve a problem I am having now, that I did not before, mainly, on the
..open, it is expecting a select statement (or somesuch error I have not seen
thus far), and I see you have one (altho now I am scratching my head as to
why the .open worked before, and not now).

There is not a lot of data to load into the table...about 40 entries, but I
am all for coding things efficiently, as I leverage my past work, in the
future.

Oh, and J was for a debug loop I was using later, that I exclude from the
code....LOL (sorry about that!).

Patk

Thanks again!

Robert Morley said:
The absolute fastest way to do what you want would be to use SQL statements
instead of looping code, but that would, of course, depend on what all you
need to do. So for now, I'll assume that doing all this through code will
be necessary at some point, and that your current algorithm makes sense for
what you ultimately need to do.

Given that, here are a couple of modifications I would make to your code.
My comments are out-dented; also watch out for line wrapping, but I assume
that'll be obvious:

Type dtype
strNameIn As String
IntInputOrder As Integer
strDataType As String
strNameOut As String
IntMaxLen As Integer
intOutputOrder As Integer
strDataSrcTbl As String
strDataSrcFld As String
End Type

Dim xArray() As dtype

With rs
.Open "SELECT * FROM TblStructure WHERE " & strSelect,
CurrentProject.Connection, adOpenStatic, adLockPessimistic, adCmdText
'Changing the SQL statement do do the work on the front end will
'save a lot of time compared to doing multiple .Find's.
.MoveLast
'Makes the .RecordCount accurate
'-----------------------------------------------------
'upsize the array to accomodate incoming data'
'-----------------------------------------------------

i = UBound(xArray)
'Assumes xArray is already used from a previous instance of this code.
'If not, then simply put i = -1

'Re-Dim for the entire recordset all at once...saves a LOT of time.
'This is, however, predicated on the idea that you can bump strSelect
'up to the WHERE clause, as I've done above.
ReDim Preserve xArray(.RecordCount + i)

j = 0
'What's j for?

.MoveFirst
Do Until .EOF
i = i + 1
'Moved up here to pre-increment, which is easier to manage in this instance.

'-----------------------------------------------------
' Load Array
'-----------------------------------------------------
xArray(i).strNameIn = ![FieldName-Input].Value
xArray(i).IntInputOrder = !FieldInputOrder.Value
xArray(i).strDataType = !FieldType.Value
xArray(i).strNameOut = ![FieldName-Output].Value
xArray(i).IntMaxLen = !FieldMaxLen.Value
xArray(i).intOutputOrder = !FieldOutputOrder.Value
xArray(i).strDataSrcTbl = !CalcSourceTbl.Value
xArray(i).strDataSrcFld = !CalcSourceField.Value
.MoveNext
Loop
End With



Rob
Click to expand...
 
Works just DANDY, Robert!

Thanks a ton!

PatK

PatK said:
Thanks...I am going to make these changes. I will let you know how it goes.
It may solve a problem I am having now, that I did not before, mainly, on the
.open, it is expecting a select statement (or somesuch error I have not seen
thus far), and I see you have one (altho now I am scratching my head as to
why the .open worked before, and not now).

There is not a lot of data to load into the table...about 40 entries, but I
am all for coding things efficiently, as I leverage my past work, in the
future.

Oh, and J was for a debug loop I was using later, that I exclude from the
code....LOL (sorry about that!).

Patk

Thanks again!

Robert Morley said:
The absolute fastest way to do what you want would be to use SQL statements
instead of looping code, but that would, of course, depend on what all you
need to do. So for now, I'll assume that doing all this through code will
be necessary at some point, and that your current algorithm makes sense for
what you ultimately need to do.

Given that, here are a couple of modifications I would make to your code.
My comments are out-dented; also watch out for line wrapping, but I assume
that'll be obvious:

Type dtype
strNameIn As String
IntInputOrder As Integer
strDataType As String
strNameOut As String
IntMaxLen As Integer
intOutputOrder As Integer
strDataSrcTbl As String
strDataSrcFld As String
End Type

Dim xArray() As dtype

With rs
.Open "SELECT * FROM TblStructure WHERE " & strSelect,
CurrentProject.Connection, adOpenStatic, adLockPessimistic, adCmdText
'Changing the SQL statement do do the work on the front end will
'save a lot of time compared to doing multiple .Find's.
.MoveLast
'Makes the .RecordCount accurate
'-----------------------------------------------------
'upsize the array to accomodate incoming data'
'-----------------------------------------------------

i = UBound(xArray)
'Assumes xArray is already used from a previous instance of this code.
'If not, then simply put i = -1

'Re-Dim for the entire recordset all at once...saves a LOT of time.
'This is, however, predicated on the idea that you can bump strSelect
'up to the WHERE clause, as I've done above.
ReDim Preserve xArray(.RecordCount + i)

j = 0
'What's j for?

.MoveFirst
Do Until .EOF
i = i + 1
'Moved up here to pre-increment, which is easier to manage in this instance.

'-----------------------------------------------------
' Load Array
'-----------------------------------------------------
xArray(i).strNameIn = ![FieldName-Input].Value
xArray(i).IntInputOrder = !FieldInputOrder.Value
xArray(i).strDataType = !FieldType.Value
xArray(i).strNameOut = ![FieldName-Output].Value
xArray(i).IntMaxLen = !FieldMaxLen.Value
xArray(i).intOutputOrder = !FieldOutputOrder.Value
xArray(i).strDataSrcTbl = !CalcSourceTbl.Value
xArray(i).strDataSrcFld = !CalcSourceField.Value
.MoveNext
Loop
End With



Rob
Click to expand...
Click to expand...
 
PatK said:
Thanks...I am going to make these changes. I will let you know how it goes.
It may solve a problem I am having now, that I did not before, mainly, on the
..open, it is expecting a select statement (or somesuch error I have not seen
thus far), and I see you have one (altho now I am scratching my head as to
why the .open worked before, and not now).
Click to expand...

That's a good question...ADO is usually pretty intelligent that way. For
future reference, where I added "adCmdText", you could add "adCmdTable" or
"adCmdTableDirect" and see if that fixes the problem. (Just don't ask me
what the difference between the two is...I've forgotten at this point,
though the names themselves certainly imply a thing or two.)
There is not a lot of data to load into the table...about 40 entries, but I
am all for coding things efficiently, as I leverage my past work, in the
future.

Oh, and J was for a debug loop I was using later, that I exclude from the
code....LOL (sorry about that!).
Click to expand...

Hehehe...been there, done that. I'm sure if I went through all my code, I'd
find LOTS of unused stuff floating around. :)
Patk

Thanks again!
Click to expand...

NP


Rob
 
Back
Top