dcsimg

Import Data from Microsoft Excel

October 21, 2005

Maybe you have noticed that Excel spreadsheets do not always import data very nicely into Access. Sure, Access can import data from various sources with just a few clicks, but Excel files seem to give the most grief. Out of necessity, I created a code module that employs automation to loop through rows of an Excel spreadsheet and systematically add data to an Access table, cell by cell. While this is not exactly a "cut and paste" solution for your data import, it does provide a nice starting point.

The Download ... caveat emptor

The download for this article contains a few simple objects that demonstrate how one might implement automation for importing data from a Microsoft Excel spreadsheet. It is NOT an Excel import tool. The downside of automation is that, for the most part, you have to have some idea of how the spreadsheet is constructed in order to import it and there has to be a table waiting as the repository. So, the demo mdb file has the following objects:

  • ImportColumnSpecs table
  • sales_import table
  • basFileImport code module
  • frmMain form

The form, shown below, serves simply as a harness for launching the code. The logic behind it is simple and does not allow for the import of any file except the sales.xls, which is also in the download package. The sales_import table is the repository I spoke of earlier and the other table, ImportColumnSpecs, is where the Excel-Column to Access-Field mapping is defined. As should be expected, the module contains the clever bit.

Remember, this is NOT an Excel import utility. Please do not write me to say that the tool doesn't work with your Excel file. It won't! This code is provided as an example and a template for you to design and execute your own import. You will need to study the code in the basFileImport module and modify it according to your needs.

Map the Import

The first step is to map the columns of the Excel to specific fields in an Access table. Our example uses a modified version of the Pubs sales table that I have named sales_import. It has only six fields and it perfectly matches the sales.xls file that contains the data I want to import. I have named the import after the name of the table and for my code to work properly, that must be the case. The column named OrdinalPosition represents the column in Excel. The ExcelColumn field is simply for reference but the AccessField field will be used to determine where to put the data during the import.

ImportColumnSpecs

ImportName

OrdinalPosition

ExcelColumn

AccessField

sales_import

1

stor_id

stor_id

sales_import

2

ord_num

ord_num

sales_import

3

ord_date

ord_date

sales_import

4

qty

qty

sales_import

5

payterms

payterms

sales_import

6

title_id

title_id

The demo database also includes a few other simplified tables from the Pubs database: stores and titles. The same mapping could be defined for both of these tables and the code modified slightly to allow for the import of data into those tables.

On to the code ...

The download contains some extra code for updating the demo form with a status message. This is useful if the import is for thousands of records and you want the user to know that processing is still moving forward. Some code is included to Unlock and Lock the spreadsheet, though the sample file is not password protected. The comments in the code should explain the process in its entirety.

Public Function ProcessFileImport(sFile As String, sTable As String) As String
   On Error GoTo ProcessFileImport_Error
   
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   
   ' Access object variables
   Dim dbs As DAO.Database
   Dim rstRead As DAO.Recordset
   Dim rstWrite As DAO.Recordset
   Dim fld As DAO.Field
   
   ' Declared variables
   Dim bytWks As Byte
   Dim bytMaxPages As Byte
   Dim intStartRow As Integer
   Dim strData As String
   Dim intMaxRow As Integer
   Dim strSQL As String
   Dim strMsg As String
   Dim intLastCol As Integer
   Dim intRow As Integer
   Dim intRec As Integer
   Dim strCurrFld As String
   Dim intCol As Integer
   Dim intLen As Integer
   Dim varValue As Variant
   Dim lngErrs As Long
   Const cPassword As String = "xxx999"
   
   DoCmd.Hourglass True
   
   ' Create the Excel Application, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sFile)
   Set dbs = CurrentDb
   
   ' Optionally, you can protect / unprotect with a password
   'wbk.Unprotect (cPassword)
   
   ' You could loop through sheets, but for this example, we'll just do one.
   bytMaxPages = 1
   
   ' Sometimes there is header info, so the "Start Row" isn't the first one.
   ' Set this variable to the first row that contains actual data.
   intStartRow = 2
   
   For bytWks = 1 To bytMaxPages
      ' Initialize variables on each pass
      Set wks = Nothing
      Set rstRead = Nothing
      intRow = intStartRow
      
      ' Load current worksheet.  Find used range to determine row count.
      Set wks = appExcel.Worksheets(bytWks)
      
      ' Optionally, you can protect / unprotect with a password
      'wks.Unprotect (cPassword)
      
      ' You need to figure out how many rows this sheet contains, so to know
      ' how far down to read.  That value is saved in intMaxRow
      strData = wks.UsedRange.Address
      intMaxRow = CInt(Mid(strData, InStrRev(strData, "$")))
      'intMaxRow = CInt(Mid(strData, LastInStr(strData, "$")))
      
      strData = ""
      
      ' Go get the list of fields for this worksheet from the Field Map table
      strSQL = "SELECT AccessField, OrdinalPosition FROM ImportColumnSpecs " & _
               "WHERE ImportName='" & sTable & "' ORDER BY OrdinalPosition ASC;"
      Set rstRead = dbs.OpenRecordset(strSQL, dbOpenDynaset)
      
      ' If there is a mistake and no specification exists, then exit with message
      If rstRead.BOF And rstRead.EOF Then
         strMsg = "The import spec was not found.  Cannot continue."
         MsgBox strMsg, vbExclamation, "Error"
      Else
         rstRead.MoveLast
         rstRead.MoveFirst
         intLastCol = rstRead.RecordCount
         
         ' The name of the import and destination table should be the same for this
         ' code to function correctly.
         Set rstWrite = dbs.OpenRecordset(sTable, dbOpenDynaset)
         Do Until intRow > intMaxRow
            ' Check row to be sure it is not blank.  If so, skip the row
            For intCol = 1 To intLastCol
               strData = strData & Trim(Nz(wks.Cells(intRow, intCol), ""))
            Next
            
            If strData = "" Then
               intRow = intRow + 1
            Else
               intRec = intRec + 1
               rstWrite.AddNew
               Do Until rstRead.EOF
                  ' Loop through the list of fields, processing them one at a time.
                  ' Grab the field name to simplify code and improve performance.
                  strCurrFld = Nz(rstRead!AccessField, "")
                  intCol = rstRead!OrdinalPosition
                  
                  ' Make sure that text fields truncate data at prescribed limits.
                  ' Users may not enter supply more text than the fields can contain.
                  If dbs.TableDefs(sTable).Fields(strCurrFld).Type = dbText Then
                     intLen = dbs.TableDefs(sTable).Fields(strCurrFld).Size
                     varValue = Left(Nz(wks.Cells(intRow, intCol), ""), intLen)
                  Else
                     varValue = wks.Cells(intRow, intCol)
                  End If
                  
                  ' The database schema requires that empty fields contain NULL, not
                  ' the empty string.
                  If varValue = "" Then varValue = Null
                  
                  ' Handle date columns.  Sometimes Excel doesn't format them as dates
                  If InStr(1, strCurrFld, "Date") > 0 Then
                     If Not IsDate(varValue) Then
                        If IsNumeric(varValue) Then
                           On Error Resume Next
                           varValue = CDate(varValue)
                           If Err.Number <> 0 Then
                              ' Can't figure out the date.  Set to null
                              varValue = Null
                              Err.Clear
                           End If
                           On Error GoTo ProcessFileImport_Error
                        Else
                           lngErrs = lngErrs + 1
                           varValue = Null
                        End If
                     End If
                     rstWrite.Fields(strCurrFld) = varValue
                  Else
                     ' If not a date field, then just write the value to the rst
                     ' (you may need to validate numeric values too)
                     rstWrite.Fields(strCurrFld) = varValue
                  End If
                  
                  rstRead.MoveNext
               Loop
               If Not rstRead.BOF Then rstRead.MoveFirst
                              
               rstWrite.Update
               
               ' Reset the variables for processing of the next record.
               strData = ""
               intRow = intRow + 1
            End If
         Loop
         Set wks = Nothing
      End If
   Next
   
Exit_Here:
   ' Report results
   strMsg = "Total of " & intRow & " records imported."
   ProcessFileImport = strMsg
   
   ' Cleanup all objects  (resume next on errors)
   ' Optionally, you can protect / unprotect with a password
   'wbk.Protect (cPassword)
   'wks.Protect (cPassword)
   On Error Resume Next
   Set wks = Nothing
   wbk.Close True
   Set wbk = Nothing
   appExcel.Quit
   Set appExcel = Nothing
   Set rstRead = Nothing
   Set rstWrite = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
   
ProcessFileImport_Error:
   MsgBox Err.Description, vbExclamation, "Error"
   Resume Exit_Here
End Function     

Roll you own

If you read through the code, you can see there is a lot of room for customization. In the above example, only one worksheet is processed, but the For Next loop allows for processing of multiple, consecutive pages. What makes this code valuable as a template is the inclusion of little tricks for doing things like unlocking a worksheet and finding the total number of used rows. These are clever bits I never want to have to figure out again.

Another prominent feature of the above code is the piece where I test for date values. If the field name is ShipDate or OrderDate, odds are the data should be in date format. I have seen where Excel converts a date into a number (in VBA dates can be expressed as numbers), which causes the insert to fail unless I convert the number back to a date. The same sort of conversion issues might surround zip codes, which look like numbers but are usually text values (the zip 01201 is not the same as the number 1201) and with percent values that include the percent sign. These text characters may have to be removed for the insert to be successful.

As you can see, it is not an out-of-the-box solution, but hopefully it will give you a starting point to create your own custom import for Microsoft Excel Files.

» See All Articles by Columnist Danny J. Lesandrini








The Network for Technology Professionals

Search:

About Internet.com

Legal Notices, Licensing, Permissions, Privacy Policy.
Advertise | Newsletters | E-mail Offers