Getting Fieldnames to also Export

[QuietRiot]

using the code below but it doesn't export field names. any ideas how to add them.

Thanks

Dim dbs As DAO.Database

Dim rstGetRecordSet As Recordset

Dim objXL As Object
Dim objCreateWkb As Object
Dim objActiveWkb As Object

Set dbs = CurrentDb
Set objXL = CreateObject("Excel.Application")
Set objCreateWkb = objXL.Workbooks.Add
Set objActiveWkb = objXL.Application.ActiveWorkBook

objXL.Visible = True
objActiveWkb.Sheets.Add
objActiveWkb.Worksheets(1).Name = "Test"

strSQL = "select * from ClientFundSetup"

Set rstGetExportData = dbs.OpenRecordset(strSQL)


With objActiveWkb.Worksheets("Test")
    .Cells(1, 1).CopyFromRecordset rstGetExportData
    .Columns.AutoFit
End With


Set objActiveWkb = Nothing
Set objCreateWkb = Nothing
Set objXL = Nothing
rstGetExportData.Close
dbs.Close
Set rstGetExportData = Nothing
Set dbs = Nothing

 

[boblarson]

This should do it for you:

Dim objXL As Object
Dim objCreateWkb As Object
Dim objActiveWkb As Object
[color=red]Dim fld As Field[/color]

Set dbs = CurrentDb
Set objXL = CreateObject("Excel.Application")
Set objCreateWkb = objXL.Workbooks.Add
Set objActiveWkb = objXL.Application.ActiveWorkBook

objXL.Visible = True
objActiveWkb.Sheets.Add
objActiveWkb.Worksheets(1).Name = "Test"

strSQL = "select * from ClientFundSetup"

Set rstGetExportData = dbs.OpenRecordset(strSQL)
[color=red]objActiveWb.Range("A1").Select
   For Each fld In rstGetExportData
       With objXL
         .ActiveCell = fld.Name
         .ActiveCell.Offset(0,1).Select
       End With
   Next fld     [/color]

With objActiveWkb.Worksheets("Test")
    .Cells([color=red]2[/color], 1).CopyFromRecordset rstGetExportData
    .Columns.AutoFit
End With


Set objActiveWkb = Nothing
Set objCreateWkb = Nothing
Set objXL = Nothing
rstGetExportData.Close
dbs.Close
Set rstGetExportData = Nothing
Set dbs = Nothing

 

[QuietRiot]

Runtime error 438 object doesn't support this property or method

@ this line objActiveWkb.Range("A1").Select

its not because you missed the K in the original either. I fixed that.

 

[QuietRiot]

Runtime error 438 object doesn't support this property or method

@ this line objActiveWkb.Range("A1").Select

its not because you missed the K in the original either. I fixed that.

actually i fixed that. but now im getting a operation is not supported by this type of object at the 2nd line: for each fld

objActiveWkb.Worksheets("Test").Range("A1").Select
For Each fld In rstGetExportData

 

[QuietRiot]

Thanks for your help.

I figured it out with this little hack job..

    Dim dbs As DAO.Database
    Dim rstGetExportData As Recordset
    Dim objXL As Object
    Dim objCreateWkb As Object
    Dim objActiveWkb As Object
    Dim fld As Field
    
    Set dbs = CurrentDb
    Set objXL = CreateObject("Excel.Application")
    Set objCreateWkb = objXL.Workbooks.Add
    Set objActiveWkb = objXL.Application.ActiveWorkBook
    
    objXL.Visible = True
    objActiveWkb.Sheets.Add
    objActiveWkb.Worksheets(1).Name = "Test"
    
    strSQL = "select * from ClientFundSetup"
    
    Set rstGetExportData = dbs.OpenRecordset(strSQL)
    
   
   
    fieldcount = rstGetExportData.Fields.Count
    objActiveWkb.Worksheets("Test").Range("A1").Select
   For x = 0 To fieldcount - 1
       With objXL
         .ActiveCell = rstGetExportData.Fields(x).Name
         .ActiveCell.Offset(0, 1).Select
       End With
   Next


    With objActiveWkb.Worksheets("Test")
        .Cells(2, 1).CopyFromRecordset rstGetExportData
        .Columns.AutoFit
    End With

    
    Set objActiveWkb = Nothing
    Set objCreateWkb = Nothing
    Set objXL = Nothing
    rstGetExportData.Close
    dbs.Close
    Set rstGetExportData = Nothing
    Set dbs = Nothing
    
End Sub