Exporting from AC2000 to a specific EXCEL 2000 Sheet

nowanda · Nov 5, 2003

Howdy!

If I wanted to export a query I would use the following code - to great success:

stQryName = "qryINT_7020560"
DoCmd.OutputTo acOutputQuery, stQryName, acFormatXLS, "C:\Result.xls"

It properly sends the results of the query into my excel file, Result.xls. However, if I wanted to send a second query into the same excel file - it overwrites the first:

stQryName = "qryINT_7020560"
DoCmd.OutputTo acOutputQuery, stQryName, acFormatXLS, "C:\Result.xls"
stQryName = "qryINT_7020561"
DoCmd.OutputTo acOutputQuery, stQryName, acFormatXLS, "C:\Result.xls"

In the above case only 7020561 appears in the Result.xls - while 7020560 does not. Is there a way to APPEND the query results from multiple queries into one file? A blank excel file has Sheet1, Sheet2, Sheet3... can we not use these or specify somehow to which sheet we want to export?

Many Thanks,

Nowanda

dk · Nov 5, 2003

Hi,

You could use the function below. It will export a recordset to a specified Excel workbook and also allow you to specify the sheet name. The only drawback of this function is that you need to enter the SQL of the query, not the query name itself e.g.

Code:

Sub TestOfExportToExcel()
    Dim MySQLString As String

    MySQLString = "SELECT Field1, Field2 FROM Table3"

    If ExportToExcel(MySQLString, "H:\temp\test.xls", "My Query") Then
        MsgBox "Success!"
    Else
        MsgBox "Failiure :-("
    End If

End Sub

Here's the function. I'm going to post this onto my website so I'd greatly appreciate any feedback/testing

Code:

Public Function ExportToExcel(TableName As String, FilePathname As String, Optional SheetName As String) As Boolean

'ExportToExcel function written by Daniel Klann, November 2003
'Exports a specified query or table to a specified file.  If the file
'already exists then that file will be used, otherwise the file will be created.

    Dim oRS As Object, oExcelApp As Object, lngFieldCounter As Long, blnFileExists As Boolean, blnExcelRunning As Boolean
    On Error GoTo errHandler

    'Firstly, open the recordset.  The TableName argument can be either a table name or
    'a valid SQL statement.
    Set oRS = CreateObject("Adodb.RecordSet")
    oRS.Open TableName, CurrentProject.Connection, 0, 1

    'Get an instance of Excel.  Use a running instance if one exists or create one if not.
    On Error Resume Next
    Set oExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        blnExcelRunning = False
        Set oExcelApp = CreateObject("Excel.Application")
    Else
        blnExcelRunning = True
    End If
    On Error GoTo errHandler

    'Now see if the specified file exists or create it if not.
    If Dir(FilePathname) <> "" Then
        blnFileExists = True
        oExcelApp.workbooks.Open FileName:=FilePathname
    Else
        oExcelApp.workbooks.Add
    End If

    On Error Resume Next
    oExcelApp.activeworkbook.sheets.Add
    oExcelApp.activesheet.Name = SheetName
    On Error GoTo errHandler

    'This loop will place the recordset field names into row 1 of the worksheet
    For lngFieldCounter = 1 To oRS.Fields.Count
        oExcelApp.cells(1, lngFieldCounter) = oRS.Fields(lngFieldCounter - 1).Name
    Next lngFieldCounter


    oExcelApp.activesheet.range("A2").copyfromrecordset oRS
    oRS.Close

    'Now save the Excel workbook and clean up
    If blnFileExists Then
        oExcelApp.activeworkbook.Save
    Else
        oExcelApp.activeworkbook.saveas FileName:=FilePathname
    End If

    oExcelApp.activeworkbook.Close

    If Not blnExcelRunning Then
        oExcelApp.Quit
        Set oExcelApp = Nothing
    End If

    Set oRS = Nothing
    ExportToExcel = True
    Exit Function


errHandler:
    ExportToExcel = False
End Function

NateO · Nov 6, 2003

Hello,

Dan, 2 cents okay? On the mult-row return, do you want to resize the range, incuding width? Also, you'll want to refer to specific sheets per the original quandary versus activesheet.

Sub PushData2()
'Via ADO
Dim myXl As Object, myBk As Object, myRng As Object
Dim Rs As ADODB.Recordset
Dim sql As String, myVar As String, myCnt As Long

'Create an Excel Instance
Set myXl = CreateObject("Excel.Application")
'Set your Excel File to push the data too
Set myBk = myXl.Workbooks.Open("c:\temp\test5.xls")

With myBk.Sheets(1)
 'Set your range to first available cell in Column A
 Set myRng = .[a65536].End(3)(2)
 'Stack an Sql Variable
 myVar = "Field 2 Variable"
 'Stack your Sql in a String
 sql = "Select F1, F2, F3 From tmpTable1 Where " & _
 "F2='" & myVar & "';"
 Set Rs = New ADODB.Recordset
 With Rs
 .ActiveConnection = CodeProject.Connection
 .Source = sql
 .Open , , adOpenStatic, adLockOptimistic
 End With
 If Not Rs.EOF Then
 Rs.MoveLast: Rs.MoveFirst
 'Rezise Excel Target Range Cell Array to
 'Accomodate Recordset Height/Width
 .Range(myRng, .Cells(Rs.RecordCount + myRng.Row, _
 3)).CopyFromRecordset Rs
 End If
 Rs.Close
 Set Rs = Nothing: Set myRng = Nothing
End With

With myBk.Sheets(2)
 'Set your range to first available cell in Column A
 Set myRng = .[a65536].End(3)(2)
 'Stack an Sql Variable
 myVar = "Field 2 Variable"
 'Stack your Sql in a String
 sql = "Select F1, F2, F3 From tmpTable2 Where " & _
 "F2='" & myVar & "';"
 Set Rs = New ADODB.Recordset
 With Rs
 .ActiveConnection = CodeProject.Connection
 .Source = sql
 .Open , , adOpenStatic, adLockOptimistic
 End With
 If Not Rs.EOF Then
 Rs.MoveLast: Rs.MoveFirst
 'Rezise Excel Target Range Cell Array to
 'Accomodate Recordset Height/Width
 .Range(myRng, .Cells(Rs.RecordCount + myRng.Row, _
 3)).CopyFromRecordset Rs
 End If
 Rs.Close
 Set Rs = Nothing: Set myRng = Nothing
End With

'Close workbook, saving it, release WB object variable
myBk.Close True: Set myBk = Nothing
'Close Excel instance, release application object variable
myXl.Quit: Set myXl = Nothing
End Sub

Hope one of these helps.

dk · Nov 6, 2003

NateO said:
Hello,

Dan, 2 cents okay? On the mult-row return, do you want to resize the range, incuding width? Also, you'll want to refer to specific sheets per the original quandary versus activesheet.

Hope one of these helps.

2 cents is fine Nate

I'm not sure I completely understand what you're saying. You don't need to use resize when using the CopyFromRecordset method - using something like Range("A2") will copy the records starting in A2.

As for the activesheet thing, I suppose I could change the function so that if the sheet already exists then use that. I guess that would be a smarter way of doing this.

Cheers,
Dan

dk · Nov 7, 2003

Here's an updated version of the function. Now, if you specify a sheet name that exists, that sheet will be used.

Code:

Public Function ExportToExcel(TableName As String, FilePathname As String, Optional SheetName As String) As Boolean

'ExportToExcel function written by Daniel Klann, November 2003
'Exports a specified query or table to a specified file.  If the file
'already exists then that file will be used, otherwise the file will be created.

    Dim oRS As Object, oExcelApp As Object, lngFieldCounter As Long
    Dim blnFileExists As Boolean, blnExcelRunning As Boolean, oTargetSheet As Object

    On Error GoTo errHandler

    'Firstly, open the recordset.  The TableName argument can be either a table name or
    'a valid SQL statement.
    Set oRS = CreateObject("Adodb.RecordSet")
    oRS.Open TableName, CurrentProject.Connection, 0, 1

    'Get an instance of Excel.  Use a running instance if one exists or create one if not.
    On Error Resume Next
    Set oExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        blnExcelRunning = False
        Set oExcelApp = CreateObject("Excel.Application")
    Else
        blnExcelRunning = True
    End If
    On Error GoTo errHandler

    'Now see if the specified file exists or create it if not.
    If Dir(FilePathname) <> "" Then
        blnFileExists = True
        oExcelApp.Workbooks.Open Filename:=FilePathname
    Else
        oExcelApp.Workbooks.Add
    End If

    'Get a reference to the sheet we're going to dump the data into.  If it already exists
    'then use that, otherwise add a sheet and name it.

    If IsEmpty(SheetName) = False Then

        On Error Resume Next
        Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets(SheetName)

        If Err.Number <> 0 Then
            Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets.Add
            oTargetSheet.Name = SheetName
        End If

    Else

        Set oTargetSheet = oExcelApp.ActiveWorkbook.Sheets.Add

    End If


    On Error GoTo errHandler

    'This loop will place the recordset field names into row 1 of the worksheet
    For lngFieldCounter = 1 To oRS.Fields.Count
        oTargetSheet.Cells(1, lngFieldCounter) = oRS.Fields(lngFieldCounter - 1).Name
    Next lngFieldCounter


    oTargetSheet.Range("A2").CopyFromRecordset oRS
    oRS.Close

    'Now save the Excel workbook and clean up
    If blnFileExists Then
        oExcelApp.ActiveWorkbook.Save
    Else
        oExcelApp.ActiveWorkbook.SaveAs Filename:=FilePathname
    End If

    oExcelApp.ActiveWorkbook.Close

    If Not blnExcelRunning Then
        oExcelApp.Quit
        Set oExcelApp = Nothing
    End If

    Set oRS = Nothing
    ExportToExcel = True
    Exit Function


errHandler:
    ExportToExcel = False
End Function

nowanda · Nov 10, 2003

Yikes!

That looks like heavily-customizable genius work! I'll try to apply both methods and let you know what works best with my data/sheets!

many thanks!

Nowanda

Exporting from AC2000 to a specific EXCEL 2000 Sheet

nowanda

Board Regular

Excel Facts

dk

MrExcel MVP

NateO

Legend

dk

MrExcel MVP

dk

MrExcel MVP

nowanda

Board Regular

Similar threads

Forum statistics

Share this page

Exporting from AC2000 to a specific EXCEL 2000 Sheet

nowanda

Board Regular

Excel Facts

dk

MrExcel MVP

NateO

Legend

dk

MrExcel MVP

dk

MrExcel MVP

nowanda

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock