Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

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

Posted on 2010-09-16
13
1,318 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 120

Expert Comment

by:Rey Obrero (Capricorn1)
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
Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

 
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
 
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 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
    xlObj.Quit
    Set xlObj = Nothing
0
 
LVL 120

Accepted Solution

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

Use Case: Protecting a Hybrid Cloud Infrastructure

Microsoft Azure is rapidly becoming the norm in dynamic IT environments. This document describes the challenges that organizations face when protecting data in a hybrid cloud IT environment and presents a use case to demonstrate how Acronis Backup protects all data.

Question has a verified solution.

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

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
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…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…

791 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