none
Can docmd.transferspreadsheet export into named sheets of a workbook?

    General discussion

  • Its not a big deal for my current project but I was thinking it would be handy to export tables into a workbook by sheet and by either updating or adding the worksheets. Using Docmd, this doesnt seem possible or possible using any single command. I assume it will take a bit of logic to manage the sheets collection with a method I'm thinking of. Then maybe I've got it all wrong, thoughts anyone?

    Monday, August 30, 2010 6:17 PM

All replies

  • I am assuming that you are exporting data from Access to Excel. Is this correct? If so, then the way I achieve this is to export the data to a new Excel workbook and then use code to copy and/or append that data to another workbook.

    The following example code exports a table to an Excel workbook then appends the exported data to a worksheet in another existing workbook. Both the workbook with the exported data and the existing workbook that holds the appended data is in a sub folder of the one where the main Access project resides.

    I am still learning Access so I am interested if anyone has a better esxample to achieve this.

    NOTE: To use the code in the standard module, in the VBA editor select Tools -> References and check the box against Microsoft Excel nn.0 Object library where nn is your version of Excel. 
     

    'The following code is a click event for a command button on an Access form
    Private Sub btnExportData_Click()
    'Exports a tavle called "tblTestData" to a NEW Excel workbook

    Dim strPath As String
    Dim strFileName As String
    Dim strPathFile As String

    strPath = CurrentProject.Path & "\Excel Export Files"
    strFileName = "TestExcelExport.xls"

    strPathFile = strPath & "\" & strFileName

    'Delete file if already existing.
    If Len(Dir(strPathFile)) > 0 Then
        Kill strPathFile
    End If

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "tblTestData", strPathFile

    Call AppendExcelData    'This sub is in a Standard module

    End Sub


    '***************************************************************

    'The following code goes in a standard module in the Access project
    'and is called from the Command button click event

    Sub AppendExcelData()
    'Copies data only that has been exported to an Excel workbook
    'and appends to existing data in an Excel workbook
    Dim objExcel As Excel.Application
    Dim strPath As String
    Dim strFileName As String
    Dim strPathFile As String
    Dim wbExported As Workbook  'The initial exported data
    Dim wbAllData As Workbook   'Workbook to copy exported data to
    Dim rngUsed As Range        'Used range in exported data

    'Try GetObject first in case Excel Application is already open.
    On Error Resume Next
    Set objExcel = GetObject(, "excel.Application")
    If Err.Number <> 0 Then
        'GetObject returns error if not already open
        'so use CreateObject
        On Error GoTo 0 'Turnoff ASAP so error trapping is available
        Set objExcel = CreateObject("Excel.Application")
    End If

    strPath = CurrentProject.Path & "\Excel Export Files"

    strFileName = "TestExcelExport.xls"

    strPathFile = strPath & "\" & strFileName

    'Open the exported data workbook and assign to a variable
    Set wbExported = objExcel.Workbooks.Open(strPathFile)

    'Open the data workbook to receive the exported data _
     and assign to a variable.
    Set wbAllData = objExcel.Workbooks.Open(strPath & "\AllData")

    'Exported data will only have one sheet so can address _
     as Sheet(1) in lieu of its name.
    With wbExported.Sheets(1).UsedRange
        Set rngUsed = .Offset(1, 0) _
            .Resize(.Rows.Count - 1, .Columns.Count)
        'Explanation of above lines of code
        'UsedRange is self explanatory
        '.Offset(1, 0) moves down one row off the column headers _
         but this then includes additional row at bottom.
        'Resize(.Rows.Count - 1, removes additional row at bottom.
        '.Columns.Count is number of column in UsedRange
    End With

    With wbAllData.Sheets("Sheet1")
        'Copy exported data and paste to first empty cell of Sheet1 in AllData
        rngUsed.Copy _
            Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End With

    wbExported.Close
    wbAllData.Save
    wbAllData.Close

    Set rngUsed = Nothing
    Set wbExported = Nothing
    Set wbAllData = Nothing
    Set objExcel = Nothing

    End Sub


    Regards, OssieMac
    • Edited by OssieMac Tuesday, August 31, 2010 2:00 AM Added Note re Tools -> References etc
    Tuesday, August 31, 2010 1:51 AM
  • Thank you OssieMac. This is nice but what it's what I expected. I was looking for a way to append into an existing workbook using MSAccess docmd.transferspreadsheet. I knew that would be way too easy and we can't have easy can we?

    I also thought it might be posible to append a sheet object with data into a sheets collection of a workbook but no that doesn't seem possible either. Maybe the Excel dev team will read this and add these features? :-)

    Thursday, September 02, 2010 5:38 PM
  • The following will append a worksheet with the exported data to the excel workbook.

    '*******************************************

    'Fode between asterisk lines is a form button event

    Private Sub btnExportAndAppendAsSheet_Click()
    'The following code is a click event for a command button on a form
    'Exports a table called "tblTestData" and appends in an Existing Excel workbook

    Dim strPath As String
    Dim strFileName As String
    Dim strPathFile As String

    strPath = CurrentProject.Path & "\Excel Export Files"
    strFileName = "TestExcelExport.xls"

    strPathFile = strPath & "\" & strFileName

    'Delete file if already existing.
    If Len(Dir(strPathFile)) > 0 Then
        Kill strPathFile
    End If

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "tblTestData", strPathFile

    Call AppendAsExcelSheet    'This sub is in a Standard module

    End Sub

    '**************************************************

    Following code in a standard module


    Sub AppendAsExcelSheet()
    'Copies data only that has been exported to an Excel workbook
    'and appends to existing data in an Excel workbook
    Dim objExcel As Excel.Application
    Dim strPath As String
    Dim strFileName As String
    Dim strPathFile As String
    Dim wbExported As Workbook  'The initial exported data
    Dim wbAllData As Workbook   'Workbook to copy exported data to
    Dim rngUsed As Range        'Used range in exported data

    'Try GetObject first in case Excel Application is already open.
    On Error Resume Next
    Set objExcel = GetObject(, "excel.Application")
    If Err.Number <> 0 Then
        'GetObject returns error if not already open
        'so use CreateObject
        On Error GoTo 0 'Turnoff ASAP so error trapping is available
        Set objExcel = CreateObject("Excel.Application")
    End If

    On Error GoTo 0

    strPath = CurrentProject.Path & "\Excel Export Files"

    strFileName = "TestExcelExport.xls"

    strPathFile = strPath & "\" & strFileName

    'Open the exported data workbook and assign to a variable
    Set wbExported = objExcel.Workbooks.Open(strPathFile)

    'Open the data workbook to receive the exported data _
     and assign to a variable.
    Set wbAllData = objExcel.Workbooks.Open(strPath & "\AllData")

    'Exported data will only have one sheet so can address _
     as Sheet(1) in lieu of its name.
    With wbExported
        .Sheets(1).Copy after:=wbAllData.Sheets(wbAllData.Sheets.Count)
    End With

    wbExported.Close
    wbAllData.Save
    wbAllData.Close

    Set rngUsed = Nothing
    Set wbExported = Nothing
    Set wbAllData = Nothing
    Set objExcel = Nothing

    End Sub

     


    Regards, OssieMac
    Thursday, September 02, 2010 7:19 PM