Solved

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

Posted on 2010-09-16
13
1,310 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
Comment Utility
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
Comment Utility
is the excel file in .xlsx format?
0
 
LVL 77

Expert Comment

by:peter57r
Comment Utility
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
Comment Utility
peter57r is correct.  The file will have to be saved down to *.xls first.
0
 
LVL 28

Expert Comment

by:omgang
Comment Utility
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
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 92

Expert Comment

by:Patrick Matthews
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Capricorn1 you are a genius!
0
 
LVL 28

Expert Comment

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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Join & Write a Comment

Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
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.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

771 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