Solved

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

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

 
0
Comment
Question by:Darinwc
  • 3
  • 3
  • 2
  • +3
13 Comments
 
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!"


ET
0
 
LVL 119

Expert Comment

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

Expert Comment

by:peter57r
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..
http://www.microsoft.com/downloads/en/details.aspx?familyid=941B3470-3AE9-4AEE-8F43-C6BB74CD1466&displaylang=en

0
 
LVL 92

Expert Comment

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

Expert Comment

by:omgang
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
0
 
LVL 2

Author Comment

by:Darinwc
ID: 33694668
omgang:

the transferspreadsheet method will not work in the usual context.  Can you post your code for automation that will work with .xlsx files?  THANKS
0
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 33694721
Darinwc,

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

Access 2007/2010 can, but not 2003.

Patrick
0
 
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.

ET
0
 
LVL 119

Expert Comment

by:Rey Obrero
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
    xlObj.Quit
    Set xlObj = Nothing
0
 
LVL 119

Accepted Solution

by:
Rey Obrero 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
    xlObj.Quit
    Set xlObj = Nothing
0
 
LVL 2

Author Comment

by:Darinwc
ID: 33695465
Capricorn1 you are a genius!
0
 
LVL 28

Expert Comment

by:omgang
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

    xlSheet.Activate

    

        '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

    Else

            '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)

            'confirm

                '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

                

        rsImport.AddNew

        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

        rsImport.Update



    Next intRow

    

ImportComplete:

        'set function return value

    strResult = varAgency



Exit_ImportSpreadsheet:

        '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

    

Err_ImportSpreadsheet:

        '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"

    Else

        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

0
 
LVL 2

Author Comment

by:Darinwc
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.
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

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

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
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.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

937 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now