
Subscript out of range error
This code does what you want.
'***********************code start**************************
Sub sGetSubFormValues(SQL As String)
Dim db As Database
Dim lrst1 As Recordset
Dim lIntFieldCount As Integer
Dim lIntRecordCount As Integer
Dim i As Integer
Dim j As Integer
Dim fld As Field
Dim gStrInitialSubFormField() As String
Dim gStrInitialSubFormFieldValue() As String
Set db = CurrentDb()
Set lrst1 = db.OpenRecordset(SQL)
lrst1.MoveLast
lIntRecordCount = lrst1.RecordCount
lIntFieldCount = fieldcount(SQL)
i = lIntFieldCount
ReDim gStrInitialSubFormField(lIntRecordCount, lIntFieldCount) As String
ReDim gStrInitialSubFormFieldValue(lIntRecordCount, lIntFieldCount) As
String
lrst1.MoveFirst
lIntFieldCount = 1
j = 1
Do Until lrst1.EOF
For Each fld In lrst1.Fields
lIntRecordCount = lrst1.RecordCount
gStrInitialSubFormField(j, lIntFieldCount) = fld.Name
gStrInitialSubFormFieldValue(j, lIntFieldCount) = Nz(fld.Value, 0)
Debug.Print j & " " & lIntFieldCount & "==> " & Nz(fld.Value, 0)
If lIntFieldCount < i Then
lIntFieldCount = lIntFieldCount + 1
Else
lIntFieldCount = 1
End If
Next
j = j + 1
If Not lrst1.EOF Then lrst1.MoveNext
Loop
End Sub
Function fieldcount(SQL As String) As Integer
Dim dtb As Database
Dim rst As Recordset
Dim i As Integer
On Error GoTo hata
Set dtb = CurrentDb
Set rst = dtb.OpenRecordset(SQL)
For i = 0 To 100 'max number of fields
'do something with the fiels
SQL = rst(i).Name
Next
Exit Function
hata:
fieldcount = i
End Function
Sub Example()
sGetSubFormValues ("Select * from Tablename;")
End Sub
'***********************code end***************************
Quote:
>Can anyone tell me why the code below produces Error 9: Subscript Out of
>Range, on the second pass through the For Each loop?
>As far as I can see the first pass through the For Each loop should
>produce elements 0,0 0,1 0,2 and so on. Then surely the second pass
>should create elements 1,0 1,1 1,2 and so on. What is wrong with this?
>Thanks in advance
>Sub sGetSubFormValues(SQL As String)
>Dim db As Database
>Dim lrst1 As Recordset
>Dim lIntFieldCount As Integer
>Dim lIntRecordCount As Integer
>Dim fld As Field
>Set db = CurrentDb()
>Set lrst1 = db.OpenRecordset(SQL)
>lrst1.MoveFirst
>Do Until lrst1.EOF
> For Each fld In lrst1.Fields
> ReDim Preserve gStrInitialSubFormField(lIntRecordCount,
>lIntFieldCount) As String
> ReDim Preserve gStrInitialSubFormFieldValue(lIntRecordCount,
>lIntFieldCount) As String
> gStrInitialSubFormField(lIntRecordCount, lIntFieldCount) =
>fld.name
> gStrInitialSubFormFieldValue(lIntRecordCount, lIntFieldCount) =
>fld.Value
> lIntFieldCount = lIntFieldCount + 1
> Next
> lrst1.MoveNext
> lIntRecordCount = lIntRecordCount + 1
> lIntFieldCount = 0
>Loop
>End Sub
>--
>Rob Hiller
>HK Consultants Ltd
>If replying by e-mail please use the address robhiller<at>netscape.net
>Any mail to The Newsreader is rejected automatically prior to download.