Loop through fields

[williamM]

Hi everyone, Im new to the forum and I have a question I cannot find an answer to.
I need to loop through fields to add header names. Every time I run the code I get an invalid operation error. So, is there a way I can loop through the fields. I do not want to have to copy and paste the code a ton of times to get this to be dynamic. I will post code.
Thanks!


While looper < 100

custName = rs("NAM")

custInfo(looper, 0) = custName
custInfo(looper, 1) = looper

Set fld(looper) = tbl.CreateField(custName, dbText) 'Where I get the error
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

Set fld(looper) = tbl.CreateField(custName & " Units", dbText)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

Set fld(looper) = tbl.CreateField(custName & " Invoice Date", dbText)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

If rs.EOF Then
looper = 100
End If

Wend

 

[AccessMSSQL]

Are your declarations like this:
Dim tbl as dao.TableDef
Dim fld as new Dao.field

Try adding the length argument to your CreateField statement
Set fld(looper) = tbl.CreateField(custName, dbText, 100)

***************************
http://www.accessmssql.com

 

[williamM]

I will paste all of the code. My declarations are not like that.


Option Compare Database

Public Function makeTable() As Long

Dim looper As Integer
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rst As New ADODB.Recordset
Dim fldName As String
Dim custName As String
Dim item As String
Dim currentItem As String
Dim custInfo(1 To 100, 0 To 1) As String

Dim dbs As Database
Dim tbl As TableDef
Dim fld As Field

Set dbs = CurrentDb
Set tbl = dbs.CreateTableDef("tblData")
Set fld = tbl.CreateField("Item No", dbText)
fld.AllowZeroLength = True
tbl.Fields.Append fld

Set rs = New ADODB.Recordset
rs.Open "select * from qryCustNames", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
rs.MoveFirst

looper = 1
While looper < 100

custName = rs("NAM")
MsgBox custName

fldName = "fld" & looper

custInfo(looper, 0) = custName
custInfo(looper, 1) = looper

Set fld(looper) = tbl.CreateField(custName, dbText)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

Set fld(looper) = tbl.CreateField(custName & " Units", dbText)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

Set fld(looper) = tbl.CreateField(custName & " Invoice Date", dbText)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

If rs.EOF Then
looper = 100
End If

Wend

dbs.TableDefs.Append tbl
Set rst = dbs.OpenRecordset("tblData")


End Function

 

[williamM]

I attempted the decelerations that you suggested and added the length to the create field statement with no luck, same error,

 

[MarkK]

At this line...

Set fld(looper) = tbl.CreateField(custName, dbText)

...you have declared fld as a Field but you appear to be trying to reference it like an array or collection with 'looper' as a subscript. You might need to declare an array of Fields or use the variable like this...

Set fld = tbl.CreateField(custName, dbText)

Cheers,

 

[williamM]

Yes!! The array worked. I cant believe I didn't think of that. Thank you so much!!
Code:
Option Compare Database

Public Function makeTable() As Long

Dim looper As Integer
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rst As New ADODB.Recordset
Dim fldName As String
Dim custName As String
Dim item As String
Dim currentItem As String
Dim custInfo(1 To 100, 0 To 1) As String

Dim dbs As Database
Dim tbl As dao.TableDef
Dim fld(0 To 100) As dao.Field

Set dbs = CurrentDb
Set tbl = dbs.CreateTableDef("tblData")
Set fld(0) = tbl.CreateField("Item No", dbText)
fld(0).AllowZeroLength = True
tbl.Fields.Append fld(0)

Set rs = New ADODB.Recordset
rs.Open "select * from qryCustNames", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
rs.MoveFirst

looper = 1
While looper < 100

custName = rs("NAM")
custName = Replace(custName, " ", "_")
custName = Replace(custName, ".", "")

fldName = "fld" & looper

custInfo(looper, 0) = custName
custInfo(looper, 1) = looper

Set fld(looper) = tbl.CreateField(custName, dbText, 100)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

Set fld(looper) = tbl.CreateField(custName & " Units", dbText)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

Set fld(looper) = tbl.CreateField(custName & " Invoice Date", dbText)
fld(looper).AllowZeroLength = True
tbl.Fields.Append fld(looper)
looper = looper + 1

rs.MoveNext

If rs.EOF Then
looper = 100
End If

Wend

dbs.TableDefs.Append tbl
'Set rst = dbs.OpenRecordset("tblData")


End Function

 

[jdraw]

Can you describe in plain English what exactly you're trying to do. Or give us a sample with some concrete names and values?
What are "header names"?

I see you have a query qryCustNames. You do realize there is a MakeTable query available within Access, right? I don't know if it applies here, but I haven't seen what exactly you want as the end result.