Import Errors when importing from Excel

Import Errors when importing from Excel

When you use TransferSpreadsheet to import data from Microsoft Excel you may often get type conversion errors, where Access assumes, based on the first few rows, that a column is a certain datatype, and unfortunately there is a value in the column that cannot be stored in the field that Access creates for the column. For example, consider the following sheet:

The trick here is to add a row at the top of the spreadsheet that has a text character where necessary. However, when you are importing tables in code, and what as much to happen automatically as possible, this can be a problem to deal with. What I do in cases like this, is to open the Excel sheet in code, check each column to see if it is numeric, and if not, insert a new row at the top of the sheet that has a text character in. Then I run the import, and finally delete the extra row if it was added. Although this adds some extra time to the whole process, it does make it more reliable as far as the user is concerned. Here is a sample of the code that I use for this:

Sub sImportFromExcel(strFile As String, strTable As String)
'   Procedure to check if the columns in an Excel sheet are text, and if necessary, insert a new row that has 'dummytext'
'   before importing the sheet into Access, and then deleting the added row from Excel
'   Accepts:
'       strFile: the name of the Excel file to be imported
'       strTable: the name of the Access table that the imported data is to be imported into
'   Note that this example assumes that there are only 3 columns in the Excel file, and that there are no column headings
'   It also only checks the first 250 rows in the worksheet - if there are less than 250 rows, any blanks are ignored
    On Error GoTo E_Handle
    Dim db As Database
    Dim rs As Recordset
    Dim strSQL As String
    Dim objXL As New Excel.Application
    Dim objXLBook As Excel.Workbook
    Dim objXLSheet As Excel.Worksheet
    Dim ablnText(1 To 3) As Boolean
    Dim blnHasText As Boolean
    Dim intLoop1 As Integer, intLoop2 As Integer
    Set objXLBook = objXL.Workbooks.Open(strFile)
    Set objXLSheet = objXLBook.Worksheets(1)
    For intLoop1 = 1 To 3
        For intLoop2 = 1 To 250
            With objXLSheet
                If Not IsNumeric(.Cells(intLoop2, intLoop1)) Then
                    If .Cells(intLoop2, intLoop1) & "" <> "" Then
                        ablnText(intLoop1) = True
                        Exit For
                    End If
                End If
            End With
        Next intLoop2
    Next intLoop1
    For intLoop1 = 1 To 3
        If ablnText(intLoop1) Then
            blnHasText = True
            Exit For
        End If
    Next intLoop1
    If blnHasText Then
        With objXLSheet
            .Range("1:1").Insert shift:=xlShiftDown
            For intLoop1 = 1 To 3
                If ablnText(intLoop1) Then
                    .Cells(1, intLoop1) = "dummytext"
                Else
                    .Cells(1, intLoop1) = 0
                End If
            Next intLoop1
        End With
        objXLBook.Save
    End If
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, strTable, strFile
    If blnHasText Then
        Set db = DBEngine(0)(0)
        For intLoop1 = 1 To 3
            If ablnText(intLoop1) Then strSQL = strSQL & "[F" & intLoop1 & "]='dummytext' AND "
        Next intLoop1
        If Len(strSQL) > 0 Then strSQL = Left(strSQL, Len(strSQL) - 5)
        strSQL = "SELECT * FROM [" & strTable & "] WHERE " & strSQL
        Set rs = db.OpenRecordset(strSQL)
        rs.Delete
    End If
    objXLSheet.Range("1:1").Delete shift:=xlShiftUp
    objXLBook.Save
sExit:
    On Error Resume Next
    Set objXLSheet = Nothing
    objXLBook.Close
    Set objXLBook = Nothing
    objXL.Quit
    Set objXL = Nothing
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & "sImportFromExcel", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

Top

Last modified at 06/06/2006 14:58:07