Need help getting column headings from Access Table 2 XL 2

[ribhead]

I'm trying to pull in information using an ADO connection and I can't quite visualize how the column headings can be written to my XL sheet. Any help would be great.

Sub Get_Info()
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strdb As String
Dim r As Integer
Dim c As Integer
Dim fld As Field
r = 1
c = 1
strdb = "D:\db2.mdb"
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strdb & ";"
strSQL = "SELECT * FROM tblmytable;"
Set rst = cnt.Execute(strSQL)
rst.MoveFirst
Do While Not rst.EOF And Not rst.BOF
For Each fld In rst.Fields
Cells(r, c) = fld
c = c + 1
Next fld
rst.MoveNext
c = 1
r = r + 1
Loop
End Sub

Thanks, Rib

Bartender:Hey aren't you that rope I threw out an hour ago?

Rope:No, I'm a frayed knot.

 

[xlbo]

so close:
For Each fld In rst.Fields
Cells(r, c) = fld

should be

For Each fld In rst.Fields
Cells(r, c) = fld.NAME

or using a more basic loop:
uRow = 1
With rst
For i = 0 To .Fields.Count - 1
Sht.Cells(uRow, i + 1).Value = rst.Fields(i).Name
Next i
end with

Rgds, Geoff

"Having been erased. the document thjat you are seeking. Must now be retyped"

Please read FAQ222-2244 before you ask a question

 

[ribhead]

Thanks Geoff but do I need a seperate For each Loop to bring in the rest of the information?

Thanks, Rib

Bartender:Hey aren't you that rope I threw out an hour ago?

Rope:No, I'm a frayed knot.

 

[xlbo]

erm....pass

I usually use DAO so I utilise the COPYFROMRECORDSET function which dumps the whole lot out in one go rather than looping through records. Don't know if it works for ADO.....worth a try tho ;-)

Rgds, Geoff

"Having been erased. the document thjat you are seeking. Must now be retyped"

Please read FAQ222-2244 before you ask a question

 

[RoyVidar]

Yes, you would need a separate loop.

Consider xlbo's suggestion to deal with the field names, then you'd also need a separate loop for the field values, along the same lines (either for each, or as I also prefer a for next).

The copyfromrecordset method of the .range object, should work with both DAO and ADO, but there are som quirks. I think fredericofonseca worked a little with this not long ago here thread707-928271, one would need to set the cursorlocation of the connection or recordset to adUseClient, I think.

Roy-Vidar

 

[ribhead]

Thanks for the post and the link. I would rather stick with what I am trying to use only because I can understand most of what's happening and I hate copying someone elses code if I can't figure out what is going on. Here is what I have but it loops twice so I get duplicate column headings. I'm not sure what to do without writing a bunch of sphaghetti code. Any thoughts ?

Sub Get_Info()
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strdb As String
Dim r As Long
Dim c As Long
Dim fld As Field
Dim fldn As Field
r = 1
c = 1
strdb = "D:\db2.mdb"
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strdb & ";"
strSQL = "SELECT * FROM tblmytable;"
Set rst = cnt.Execute(strSQL)
rst.MoveFirst
Do While Not rst.EOF And Not rst.BOF
For Each fldn In rst.Fields
Cells(r, c) = fldn.Name
c = c + 1
Next fldn
c = 1
r = r + 1
For Each fld In rst.Fields
Cells(r, c) = fld
c = c + 1
Next fld

rst.MoveNext
c = 1
r = r + 1
Loop
End Sub

Thanks, Rib

Bartender:Hey aren't you that rope I threw out an hour ago?

Rope:No, I'm a frayed knot.

 

[RoyVidar]

The "field name" part would need to be outside the main loop

[tt]if Not rst.EOF And Not rst.BOF then
For Each fldn In rst.Fields
Cells(r, c) = fldn.Name
c = c + 1
Next fldn
c = 1
r = r + 1
Do While Not rst.EOF And Not rst.BOF
For Each fld In rst.Fields
Cells(r, c) = fld
c = c + 1
Next fld
rst.MoveNext
c = 1
r = r + 1
Loop
else
msgbox "no records found..."
endif[/tt]

- hint hint - a little indentation makes it a bit easier to read;-)

Roy-Vidar

 

[ribhead]

Sorry, about no indentations. I am trying to teach myself VBA and I am not quite sure on all the settings to make things easier for myself and others to follow. You are right it does make things easier with indenting.

Thanks, Rib

Bartender:Hey aren't you that rope I threw out an hour ago?

Rope:No, I'm a frayed knot.

 

[xlbo]

well you do have 2 loops !!
change

rst.MoveFirst
Do While Not rst.EOF And Not rst.BOF
For Each fldn In rst.Fields
Cells(r, c) = fldn.Name
c = c + 1
Next fldn
c = 1
r = r + 1
For Each fld In rst.Fields
Cells(r, c) = fld
c = c + 1
Next fld

rst.MoveNext

to

rst.MoveFirst
For Each fldn In rst.Fields
Cells(r, c) = fldn.Name
c = c + 1
Next fldn

Cells(2, 1).CopyFromRecordset rst

Rgds, Geoff

"Having been erased. the document thjat you are seeking. Must now be retyped"

Please read FAQ222-2244 before you ask a question

 

[ribhead]

Bravo Geoff, This is much easier. Great job... you get a purple spur from me.

Thanks

Thanks, Rib

Bartender:Hey aren't you that rope I threw out an hour ago?

Rope:No, I'm a frayed knot.