Check if tables match before importing excel to access (1 Viewer)

[ili_sophia]

Hello,

I need to import my excel worksheet to a specific access table. However, when a user accidentally select the wrong excel worksheet, the tables would not match. Hence, the error would prompt Run time error 2391 Field "PO" doesn't exist in destination table "Printing". which would lead the user to either end the run or debug it.
How do I allow access to check if the tables matches using VBA?. If the user accidentally select the wrong file and attempt to import it, it will prompt them with an error message of "Tables do not match. Please select another file"

Thank you

 

[JHB]

You could use the error number in an error handling part, (VBA code) to skip the import if it doesn't match.

When "the tables would not match" do you mean, the field names or the datatype?
If the order of the columns the same as the order of the fields?

 

[ili_sophia]

The user form will import the excel work sheet data into the same table hence the worksheet and access table columns have to be the same.
Therefore, the table would not match is the field names in the column heading.

the case where in which the tables field name would not match is when a user accidentally select the wrong excel worksheet to import and the error comes out.

How do i overcome this to prompt a message to show that the excel file chosen is wrong and that the tables do not match hence they need to select another file

 

[Cronk]

You said if the wrong spreadsheet is selected you get Run time error 2391

What JBH is saying is to add the following to your code

if err = 2391 then
   msgbox "The wrong spreadsheet has been selected"
   exit sub
endif

 

[arnelgp]

here is a function for you to use.
the workbook should not be open when
you check with this function.

Public Function IsWBStructureSame(ByVal strWorkBook As String, strSheetName As String, strTable As String) As Boolean
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '
    ' check to see if Sheet Column Names and Count same as with Table
    '
    ' Parameters:
    '
    ' strWorkBook       : The path and filename (plus extension) of excel workbook (eg "d:\Data\book1.xlsx")
    ' strShhetName      : The name of sheet to compare
    ' strTable          " The name of table to compare
    '
    ' NOTES:
    '
    '       function only check for Field/Column names and not datatype
    '       exludes Autonumberfield
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Const ExcelConnection As String = "Excel 12.0 Xml; IMEX = 2; HDR = YES; ACCDB = YES"
    
    Dim arrTableFieldNames() As String
    Dim arrSheetColumnNames() As String
    
    Dim td As DAO.TableDef
    Dim fld As DAO.Field
    Dim wb As Excel.Workbook
    Dim xlDB As DAO.Database
    Dim xlRs As DAO.recordSet
    Dim intFieldCount As Integer
    Dim intColumnCount As Integer
    Dim bolSecondpass As Boolean
    Dim i As Integer
    Dim db As DAO.Database
    
    Set db = CurrentDb
    Set td = db.TableDefs(strTable)
    For Each fld In td.Fields
        If Not IsAutoNumber(fld) Then
            'do nothing don't add autonumber field
            If bolSecondpass Then
                ReDim Preserve arrTableFieldNames(UBound(arrTableFieldNames) + 1)
            Else
                ReDim arrTableFieldNames(0)
                bolSecondpass = True
            End If
            arrTableFieldNames(UBound(arrTableFieldNames)) = fld.Name
        End If
    Next
    intFieldCount = UBound(arrTableFieldNames)
    bolSecondpass = False
    Set xlDB = OpenDatabase(strWorkBook, False, True, ExcelConnection)
    Set xlRs = xlDB.OpenRecordset("SELECT * FROM [" & strSheetName & "$] WHERE (0=1);")
    For Each fld In xlRs.Fields
        If bolSecondpass Then
            ReDim Preserve arrSheetColumnNames(UBound(arrSheetColumnNames) + 1)
        Else
            ReDim arrSheetColumnNames(0)
            bolSecondpass = True
        End If
        arrSheetColumnNames(UBound(arrSheetColumnNames)) = fld.Name
    Next
    intColumnCount = UBound(arrSheetColumnNames)
    
    If intColumnCount = intFieldCount Then
        For i = 0 To UBound(arrSheetColumnNames)
            IsWBStructureSame = True
            If arrSheetColumnNames(i) <> arrTableFieldNames(i) Then
                IsWBStructureSame = False
                Exit For
            End If
        Next
    End If
        
exitFunction:
    Erase arrTableFieldNames
    Erase arrSheetColumnNames
    If Not (xlRs Is Nothing) Then xlRs.Close
    Set xlRs = Nothing
    If Not (xlDB Is Nothing) Then xlDB.Close
    Set xlDB = Nothing
    Set td = Nothing
    Set fld = Nothing
    Set db = Nothing
    Exit Function
    
errorFunction:
    MsgBox err.Number & ": " & err.Description
    Resume exitFunction
End Function

Private Function IsAutoNumber(ByRef fld As Object) As Boolean
On Error GoTo ErrHandler

  If TypeOf fld Is ADODB.Field Then
    IsAutoNumber = (fld.Properties("ISAUTOINCREMENT") = True)
  ElseIf TypeOf fld Is DAO.Field Then
    IsAutoNumber = (fld.Attributes And dbAutoIncrField)
  Else
    err.Raise vbObjectError + 100, "IsAutoNumber()", _
      "Unsupported Field Type argument: " & TypeName(fld)
  End If

ExitHere:
  Exit Function
ErrHandler:
  Debug.Print err, err.Description
  Resume ExitHere
End Function