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

Posted on 2010-09-16
Medium Priority
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..

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

LVL 93

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 93

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 2000 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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
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 …
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

750 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