MS Access 2003 / VBA: use VBA to import a 2007 spreadsheet?

Posted on 2010-09-16
Last Modified: 2012-06-27
How can I use Access 2003 to import an Excel 2007 spreadsheet using VBA?

Question by:Darinwc
  • 3
  • 3
  • 2
  • +3
LVL 19

Expert Comment

by:Eric Sherman
ID: 33693621
Try this ... use the TransferSpreadsheet method.  Fill in your actual table and file name.  Change False to True if the sheet has field names.  Also replace Range with the named range in your worksheet or the worksheet name.

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "YourTableName", "C:\YourFileName.xls", False, "Range!"

LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 33693712
is the excel file in .xlsx format?
LVL 77

Expert Comment

ID: 33693765
I don't believe you can do it, Darinwc.
Access 2003 has no command to accept xlsx/xlsm files.

You can open xlsx files in Excel 2003 if you have installed the compatibility pack and that will let you save as a xls file which you should then be able to import into A2003.

Compatibility pack..

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

LVL 92

Expert Comment

by:Patrick Matthews
ID: 33693947
peter57r is correct.  The file will have to be saved down to *.xls first.
LVL 28

Expert Comment

ID: 33693952
With the Compatability pack Access 2003 will be able to import Excel 2007 .xlsx files.  Not sure about doing it with TransferSpreadsheet but I have an app in Access 2003 that imports Excel spreadsheets via automation and will work with both .xls and .xlsx files.
OM Gang

Author Comment

ID: 33694668

the transferspreadsheet method will not work in the usual context.  Can you post your code for automation that will work with .xlsx files?  THANKS
LVL 92

Expert Comment

by:Patrick Matthews
ID: 33694721

You CANNOT read in an xlsx file into Access 2003 using TransferSpreadsheet.  CANNOT be done.

Access 2007/2010 can, but not 2003.

LVL 19

Expert Comment

by:Eric Sherman
ID: 33694789
matthewspatrick is correct ...

I assumed since you were using Access 2003 that you were going to make your Excel worksheet a compatible format.

LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 33694875
you can convert the .xlsx to .csv file and import the .csv file

Dim xlObj As Object
Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open CurrentProject.Path & "\Book2.xlsx"
    xlObj.activeworkbook.saveas FileName:=CurrentProject.Path & "\Book2.csv", _
        FileFormat:=6, CreateBackup:=False
    xlObj.displayalerts = False
    Set xlObj = Nothing
LVL 120

Accepted Solution

Rey Obrero (Capricorn1) earned 500 total points
ID: 33694908
or save as .xls

Dim xlObj As Object
Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open CurrentProject.Path & "\Book2.xlsx"

    xlObj.activeworkbook.saveas FileName:=CurrentProject.Path & "\Book2.xls", _
        FileFormat:=-4143, CreateBackup:=False
    xlObj.displayalerts = False
    Set xlObj = Nothing

Author Comment

ID: 33695465
Capricorn1 you are a genius!
LVL 28

Expert Comment

ID: 33695689
Darinwc, glad cap's solution is working for you.  Since you asked to see the automation code I've provided it below.  In a nutshell it's importing Excel workbooks, .xls or .xlsx, into a local table for further processing.  I chose automation over TransferSpreadsheet so I could control the import on a cell by cell basis.  Compatability Pack must be installed on the machine to work with Excel 2007 .xlsx files (when using Access 2003)
OM Gang
Public Function ImportSpreadsheet(strFilePath As String) As String
'imports data from specified MS Excel spreadsheet into local table
On Error GoTo Err_ImportSpreadsheet

    Dim xlApp As New Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim objCell As Object
    Dim db As DAO.Database
    Dim rs As DAO.Recordset, rsImport As DAO.Recordset
    Dim blBookOpen As Boolean
    Dim intRow As Integer, intColumn As Integer, intResponse As Integer
    Dim intMaxRow As Integer, intMaxCol As Integer
    Dim strSpecTable As String, strWorkSheet As String, strVersion As String
    Dim strLocalTbl As String, strPreparer As String
    Dim strQt As String, strResult As String, strMsg As String
    Dim varCurCell As Variant, varAgency As Variant
    Dim varBusUnit As Variant, varValidBusUnit As Variant
        'initialize return value
    strResult = ""

        'assign single quotation mark (") to string variable
    strQt = Chr$(34)
        'display hourglass while we're working
    DoCmd.Hourglass True
        'name of local table we want to import into
    strLocalTbl = "ImportedData"
        'set database object variable to current database
    Set db = CurrentDb

        'name of local table with source form specs we want to compare against
    strSpecTable = "SourceFormSpecs"
        'get version and name of worksheet we want to import
    strWorkSheet = Nz(DLookup("WorksheetName", strSpecTable), "")
    strVersion = Nz(DLookup("VersionNum", strSpecTable), "")

        'check to make sure we retrieve values
    If strWorkSheet = "" Or strVersion = "" Then
        strMsg = "Form spec table " & strSpecTable & " not found or is empty."
        strMsg = strMsg & vbCrLf & "Cannot import data."
        MsgBox strMsg, , "Can't Find Import Specs"
        GoTo Exit_ImportSpreadsheet
    End If
        'make sure the file name passed is for an Excel workbook
    If Right(strFilePath, 4) <> ".xls" And Right(strFilePath, 5) <> ".xlsx" Then
        strMsg = "The file you selected does not appear to be a valid MS Excel File.  " _
                & "Operation cancelled."
        MsgBox strMsg, , "Invalid File Type"
        GoTo Exit_ImportSpreadsheet
    End If

        'open the workbook
    xlApp.Workbooks.Open (strFilePath)
        'set flag indicating workbook is open
    blBookOpen = True

        'select sheet to work with
    Set xlSheet = xlApp.ActiveWorkbook.Sheets(strWorkSheet)
        'make sure it is the current/active worksheet
        'set local destination table to recordset variable
    Set rsImport = db.OpenRecordset(strLocalTbl)

        'get preparer info. from worksheet cell
    strPreparer = Nz(xlSheet.Cells(1, 3), "None")
    'Debug.Print strPreparer
        'compare version number of worksheet with version number retrieved from spec table
    If Nz(xlSheet.Cells(1, 5), "empty") <> strVersion Then
        strMsg = "The version of the submitted report does not match the current version " _
                & "(" & strVersion & ")."
        strMsg = strMsg & vbCrLf & "Please notify the submitting agency to resubmit using " _
                & "the current version of the report."
        MsgBox strMsg, , "Incorrect Report Version"
        GoTo Exit_ImportSpreadsheet
    End If
    intMaxRow = 2000
    intMaxCol = 40
        'get the business unit entered in spreadsheet cell A5 and have user confirm this is the business unit
        'we are importing records for
    Set objCell = xlSheet.Cells(5, 1)
    varCurCell = CStr(objCell.Value)
    varBusUnit = varCurCell
    varValidBusUnit = DLookup("BusUnit", "dbo_BusinessUnits", "BusUnit = " & strQt & varBusUnit & strQt)
        'check to make sure business unit specified is valid
    If IsNull(varValidBusUnit) Then
        strMsg = "The value listed in cell A5 of worksheet '" & strWorkSheet & "' in workbook " & strFilePath _
                & " is invalid."
        strMsg = strMsg & vbCrLf & "Value in cell A5 = " & varBusUnit
        MsgBox strMsg, , "Invalid Business Unit"
        GoTo ImportComplete
            'lookup agency name for business unit retrieved
        varAgency = DLookup("BusUnitName", "dbo_BusinessUnits", "BusUnit = " & Chr(34) & varBusUnit & Chr(34))
        strMsg = "Import records for " & Nz(varAgency, "Problem Retrieving Agency Name") _
                & ", Business Unit #" & varBusUnit & "?"
        intResponse = MsgBox(strMsg, vbYesNo, "Please Confirm")
        If intResponse = vbNo Then GoTo Exit_ImportSpreadsheet
    End If
        'iterate through each spreadsheet cell within the range from
        '(5, 1) to (highest row number, highest column number)
    For intRow = 5 To intMaxRow
        Set objCell = xlSheet.Cells(intRow, 1)
        varCurCell = CStr(objCell.Value)
                '1) there is a non-empty, non-null value in the first column of each row
                '2) the value matches the business unit we retrieved from cell A5
            If Nz(varCurCell, "empty") <> varBusUnit Then
                    'finished processing sheet so jump to end
                GoTo ImportComplete
            End If
        For intColumn = 1 To intMaxCol
                'assign selected cell range object to variable
            Set objCell = xlSheet.Cells(intRow, intColumn)
            varCurCell = objCell.Value

        Select Case intColumn
                'text/string values
            Case 1, 2, 3, 4, 5, 6, 8, 9, 12, 13, 14, 15, 16, 17, 20, 28, 36, 39, 40
                'rsImport(intColumn - 1) = CStr(varCurCell.Value)
                rsImport(intColumn - 1) = CStr(varCurCell)
                'general number values
            Case 7, 10, 11, 19
                'rsImport(intColumn - 1) = CDbl(varCurCell.Value)
                rsImport(intColumn - 1) = CDbl(varCurCell)
                'decimal value - SQL db set to 2 decimal places
            Case 37, 38
                rsImport(intColumn - 1) = Round(CDbl(varCurCell), 2)
                'currency values
            Case 18, 21, 22, 23, 24, 25, 26, 27, 29, 30, 31, 32, 33, 34, 35
                'rsImport(intColumn - 1) = CCur(varCurCell.Value)
                rsImport(intColumn - 1) = CCur(varCurCell)
            Case Else
        End Select
        Next intColumn

    Next intRow
        'set function return value
    strResult = varAgency

        'no more hourglass
    DoCmd.Hourglass False
        'clear object variables
    Set objCell = Nothing
    Set xlSheet = Nothing
        'if the workbook exists, close it - don't save changes
    If blBookOpen Then xlApp.ActiveWorkbook.Close (False)
        'if we started an instance of MS Excel, terminate it
    If Not xlApp Is Nothing Then xlApp.Quit
    Set xlApp = Nothing
    Set rsImport = Nothing
    Set db = Nothing
        'function return value
    ImportSpreadsheet = strResult
    Exit Function
        'trap error 1004 - path/filename specified cannot be found
    If Err.Number = 1004 Then
        strMsg = "The input path/file " & strFilePath & " could not be found.  " _
                & "Make sure the path and file name are spelled"
        strMsg = strMsg & vbCrLf & "correctly on form Input/Output File Paths " _
                & "And File Names and/or that the source file"
        strMsg = strMsg & vbCrLf & strFilePath & " actually exists at the location " _
                & "specified.  Contact the application administrator"
        strMsg = strMsg & vbCrLf & "if you need help."
        MsgBox strMsg, , "Input File Error"
        Resume Exit_ImportSpreadsheet
        'trap error 9 - subscript out of range prior to processing any rows
        'occurs when specified worksheet name cannot be found in the workbook (report)
    ElseIf Err.Number = 9 And intRow = 0 Then
        strMsg = "A worksheet named " & strWorkSheet & " cannot be found in the report."
        MsgBox strMsg, , "Error in ImportSpreadsheet function"
        strMsg = Err.Number & ", " & Err.Description
        strMsg = strMsg & vbCrLf & "Error occurred while processing row " _
                & intRow & ", column " & intColumn & "."
        MsgBox strMsg, , "Error in ImportSpreadsheet function"
    End If

        'set function return value unsuccessful
    strResult = ""
    Resume Exit_ImportSpreadsheet

End Function

Open in new window


Author Comment

ID: 33705295
Thanks OMG! For my app the transferspreadsheet function is preffered but you have some good usable code in there that I'm sure will help out others.

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question