• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1341
  • Last Modified:

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

How can I use Access 2003 to import an Excel 2007 spreadsheet using VBA?

  • 3
  • 3
  • 2
  • +3
1 Solution
Eric ShermanAccountant/DeveloperCommented:
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!"

Rey Obrero (Capricorn1)Commented:
is the excel file in .xlsx format?
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..

Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

Patrick MatthewsCommented:
peter57r is correct.  The file will have to be saved down to *.xls first.
omgangIT ManagerCommented:
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
DarinwcAuthor Commented:

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

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

Access 2007/2010 can, but not 2003.

Eric ShermanAccountant/DeveloperCommented:
matthewspatrick is correct ...

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

Rey Obrero (Capricorn1)Commented:
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
Rey Obrero (Capricorn1)Commented:
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
DarinwcAuthor Commented:
Capricorn1 you are a genius!
omgangIT ManagerCommented:
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

DarinwcAuthor Commented:
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.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

  • 3
  • 3
  • 2
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now