[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

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

Posted on 2010-09-16
13
Medium Priority
?
1,329 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
[X]
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
  • 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
Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

 
LVL 93

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 93

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

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

AutoNumbers should increment automatically, without duplicates.  But sometimes something goes wrong, and the next AutoNumber value is a duplicate.  This article shows how to recover from this problem.
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, when working with VBA, learn some techniques for writing readable and easily maintained code.
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses

650 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