List fieldnames from table via SQL in vba 1

[boein]

Hi,

How do I make a list of the fieldnames of a table using SQL in vba. I want to make a query that puts the results in an excel sheet. If I do a runsqlexec select * from table, I get all the records from the table but the fieldnames for each record are missing. Anybody ideas?

Thanks
Boein

 

[dhookom]

There is not a method for selecting field names from a sql query in Access. You would need to write some DAO or other code to loop through the fields collection.

Duane MS Access MVP

 

[boein]

Hi,

it's not an access database, it's a notes database I connect to through odbc. Do you have a sample code I can use to get the fieldnames from that database? I find it strange that I can get all the data from the database except the fieldnames using select *. There must be a way right?

Regards
Boein

 

[Remou]

You could use schemas.

Function ListFieldDescriptions()
'List field descriptions
Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset
Dim connString As String
 
Set cn = CurrentProject.Connection
 
Set rs = cn.OpenSchema(adSchemaTables, _
            Array(Empty, Empty, Empty, "table"))
 
While Not rs.EOF
        Debug.Print rs!table_name; "   desc=  "; rs!Description
        Set rs2 = cn.OpenSchema(adSchemaColumns, _
            Array(Empty, Empty, "" & rs!table_name & ""))
        While Not rs2.EOF
            Debug.Print "     " & rs2!Column_Name
            Debug.Print "     " & rs2!Data_Type
            Debug.Print "     " & rs2!Description
            Debug.Print "     " & rs2!Is_Nullable
            rs2.MoveNext
        Wend
    rs.MoveNext
Wend
rs.Close
Set cn = Nothing
 
End Function

http://www.w3schools.com/ado/met_conn_openschema.asp

 

[CaptainD]

remou,

I've always been told you could not get the schemainformation from Access Databases, I ran this function from access and got all my table information.

It worked great, have a star

D

 

[boein]

Thanks Remou,

your code works. But still one problem, the fieldnames returned by your code do not correspond with the records returned by my sql query select * from table. I changed your code so it only returns the table I need, by something got mixed up with the order in wich they are returned. Any suggestions for that one?

Thanks
Boein

 

[Remou]

You can use a variety of schemas, there are lots in the the link. This is for select queries:

Function ListFieldDescriptions()
'List field descriptions
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset
Dim connString As String

Set cn = CurrentProject.Connection

  Set rs = cn.OpenSchema( _
         adSchemaViews, Array(Empty, Empty, "QueryName"))

While Not rs.EOF
        Debug.Print rs!TABLE_NAME; "   desc=  "; rs!Description
        Set rs2 = cn.OpenSchema(adSchemaColumns, _
            Array(Empty, Empty, "" & rs!TABLE_NAME & ""))
        While Not rs2.EOF
            Debug.Print "     " & rs2!COLUMN_NAME
            rs2.MoveNext
        Wend
    rs.MoveNext
Wend
rs.Close
Set cn = Nothing

End Function

Are you aware that you can refer to recordset fields by number?

[tt]For i=0 rs.Fields.Count-1
Debug.Print rs.Fields(i).Name
Next[/tt]

 

[boein]

No i'm not quite familiar with vba and ADO so I could need some help here. This is my code, in this code yo'll also find a piece of your code I changed to make it work in my application. It does work but colums are mixed. What am I doing wrong here?


Private Sub CommandButton1_Click()
Dim xlCalc As XlCalculation
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim col As Integer
Dim cnt
Set cnt = CreateObject("ADODB.Connection")
Dim rs
Set rs = CreateObject("ADODB.recordset")
Dim rs2
Set rs2 = CreateObject("ADODB.recordset")
Const stSQL As String = "SELECT * FROM PP"
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = True
End With
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(2)
With wsSheet
Set rnData = .Range("A2")
End With
Set cnt = CreateObject("ADODB.Connection")
cnt.Open ("Driver={Lotus NotesSQL Driver (*.nsf)};Database=notes.nsf;Server=dominosrv;")

Set rs = cnt.OpenSchema(adSchemaTables, _
Array(Empty, Empty, Empty, "table"))
While Not rs.EOF
'Debug.Print rs!table_name; " desc= "; rs!Description
Set rs2 = cnt.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, "" & rs!table_name & ""))
If rs!table_name = "PP" Then
col = 1
While Not rs2.EOF
Sheet1.Cells(1, col) = rs2!Column_Name
rs2.MoveNext
col = col + 1
Wend
End If
rs.MoveNext
Wend

Set rs = cnt.Execute(stSQL)
rnData.CopyFromRecordset rs
rs.Close
cnt.Close
Set cnt = Nothing
Set rs = Nothing
With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

 

[Remou]

Ok. Try this but be aware this is an Access forum, and you seem to be using Lotus Notes:

Private Sub CommandButton1_Click()
   Dim xlCalc As XlCalculation
   Dim wbBook As Workbook
   Dim wsSheet As Worksheet
   Dim rnData As Range
   Dim col As Integer
   Dim cnt
   Set cnt = CreateObject("ADODB.Connection")
   Dim rs
   Set rs = CreateObject("ADODB.recordset")
   Const stSQL As String = "SELECT * FROM PP"
   With Application
      xlCalc = .Calculation
      .Calculation = xlCalculationManual
      .EnableEvents = False
      .ScreenUpdating = True
   End With
   Set wbBook = ThisWorkbook
   Set wsSheet = wbBook.Worksheets(2)
   With wsSheet
   Set rnData = .Range("A2")
   End With
   Set cnt = CreateObject("ADODB.Connection")
   cnt.Open ("Driver={Lotus NotesSQL Driver (*.nsf)};Database=notes.nsf;Server=dominosrv;")
   rs.Open strSQL, cnt
 
    For i=0 to rs.Fields.Count-1
        Sheet1.Cells(1, i+1) = rs.Fields(i)
    Next
    rs.Close

Set rs = cnt.Execute(stSQL)
   rnData.CopyFromRecordset rs
   rs.Close
   cnt.Close
   Set cnt = Nothing
   Set rs = Nothing
   With Application
      .Calculation = xlCalc
      .EnableEvents = True
      .ScreenUpdating = True
   End With
End Sub

 

[boein]

Still doesn't work, program crashes at
rs.Open strSQL, cnt

I removed those lines and replaces it with
Set rs = cnt.Execute(stSQL)
this works, but still gives the data from the record not the fields.

Any ideas?

 

[Remou]

It is quite probably the 'r' st[red]r[/red]SQL and stSQL. However, this is simpler.

Private Sub CommandButton1_Click()
   Dim xlCalc As XlCalculation
   Dim wbBook As Workbook
   Dim wsSheet As Worksheet
   Dim rnData As Range
   Dim col As Integer
   Dim cnt
   Set cnt = CreateObject("ADODB.Connection")
   Dim rs
   Set rs = CreateObject("ADODB.recordset")
   Const stSQL As String = "SELECT * FROM PP"
   With Application
      xlCalc = .Calculation
      .Calculation = xlCalculationManual
      .EnableEvents = False
      .ScreenUpdating = True
   End With
   Set wbBook = ThisWorkbook
   Set wsSheet = wbBook.Worksheets(2)
   With wsSheet
   Set rnData = .Range("A2")
   End With
   Set cnt = CreateObject("ADODB.Connection")
   cnt.Open ("Driver={Lotus NotesSQL Driver (*.nsf)};Database=notes.nsf;Server=dominosrv;")

Set rs = cnt.Execute(stSQL)
   For i=0 to rs.Fields.Count-1
      Sheet1.Cells(1, i+1) = rs.Fields(i)
   Next

   rnData.CopyFromRecordset rs
   rs.Close
   cnt.Close
   Set cnt = Nothing
   Set rs = Nothing
   With Application
      .Calculation = xlCalc
      .EnableEvents = True
      .ScreenUpdating = True
   End With
End Sub

 

[boein]

Thanks for your efforts Remou but still no fieldnames.
When I run this code row 1 and 2 are the same, filled with data (probably the first record from the database). However still no fieldnames in row1.

Regards
Boein

 

[dhookom]

The default property of the field is the Value. If you want the names of the fields, try:

   For i=0 to rs.Fields.Count-1
      Sheet1.Cells(1, i+1) = rs.Fields(i).Name
   Next

Duane MS Access MVP

 

[Remou]

Thanks Duane. I mentioned Name in a previous post (28 Feb 08 16:54) and forgot it here.

 

[boein]

Thanks alot guys,

it works!

Kind regards
Boein

 

[timb94]

Remou:

I have a similar problem I'm trying to work throught. All I'm trying to do is extract the field name into an array.

I copied your solution above and deleted the code related to Lotus but I'm hung up on one part.

If I understand your code (and my ADODB knowledge is very weak) I should be able to use the following:

Set rs = cnt.Execute(stSQL)
For i=0 to rs.Fields.Count-1
    somearray = rs.Fields(i).Name
Next

The problem I'm having is with the Set command. In your code your connecting to a Lotus driver. Is there another way to write this without using the connection string?

Any assistance would be appreciated.

 

[CaptainD]

timb94

You need to connect to the database. Here is a site that has the connection criteria for various databases etc.

http://www.connectionstrings.com/

 

[PHV]

Dim somearray()
Set rs = cnt.Execute(stSQL)
ReDim somearray(rs.Fields.Count)
For i=0 to rs.Fields.Count-1
somearray(i) = rs.Fields(i).Name
Next

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[timb94]

Thanks everyone but I figured it out.

All I did was replace the Set rs = cnt.Execute(stSQL) with Set rs = Currentdb.Openrecordset(stSQL).