VBA Code to load a tab delimited file to a MS Access table


Public Function fnBulkInsertTab(sFilename As String)
 On Error GoTo fnBulkInsertTab_Error_Routine

 Dim sErrFilename As String
 sErrFilename = "c:\logs\err" & Format(Now(), "yyyymmddHHMMSS") & ".txt"

 Dim i As Long
 Dim s As String
 Dim sInputChar As String
 Dim sSQL01 As String
 Dim sSQL02 As String
 Dim f As Integer

 If fnTableExists("tblBulkInsert") Then DoCmd.RunSQL "DROP TABLE tblBulkInsert"
 DoCmd.RunSQL "CREATE TABLE tblBulkInsert (" & _
    "f1 varchar,f2 varchar,f3 varchar,f4 varchar,f5 varchar," & _
    "f6 varchar," & _
    "f7 varchar," & _
    "f8 varchar," & _
    "f9 varchar," & _
    "f10 varchar," & _
    "f11 varchar," & _
    "f12 varchar," & _
    "f13 varchar," & _
    "f14 varchar," & _
    "f15 varchar," & _
    "f16 varchar," & _
    "f17 varchar," & _
    "f18 varchar," & _
    "f19 varchar," & _
    "f20 varchar," & _
    "f21 varchar," & _
    "f22 varchar," & _
    "f23 varchar," & _
    "f24 varchar," & _
    "f25 varchar," & _
    "f26 varchar" & _
    ");"

 i = 1
 f = 1
 s = ""
 sInputChar = ""
 sSQL01 = ""
 sSQL02 = ""

 Open sFilename For Input As #10
    Do Until EOF(10)
        sInputChar = Input(1, #10)
        If Asc(sInputChar) < 127 Then
            If sInputChar = "'" Then
                GoTo Next_Char
            End If
            If sInputChar = vbTab Then
                If f = 1 Then
                    sSQL01 = "INSERT INTO tblBulkInsert (f1"
                    sSQL02 = "VALUES ('" & s & "'"
                End If
                If f > 1 Then
                    sSQL01 = sSQL01 & ",f" & f
                    sSQL02 = sSQL02 & ",'" & s & "'"
                End If
                s = ""
                f = f + 1
                GoTo Next_Char
            End If
            If sInputChar = vbCr Then
'                MsgBox (s)
'                MsgBox ("CR")
'                Debug.Print "CR"
                sSQL01 = sSQL01 & ",f" & f & ") "
                sSQL02 = sSQL02 & ",'" & s & "');"
                sSQL01 = sSQL01 & sSQL02
'                MsgBox sSQL01
                DoCmd.RunSQL sSQL01
                s = ""
                sSQL01 = ""
                sSQL02 = ""
                f = 1
                GoTo Next_Char
            End If
            If sInputChar = vbLf Then
'                MsgBox ("LF")
'                Debug.Print "LF"
                s = ""
                GoTo Next_Char
            End If
            s = s & sInputChar
        End If
Next_Char:
        i = i + 1
'        If i = 40 Then Exit Do
    Loop

fnBulkInsertTab_Exit_Routine:
' MsgBox "Exit Routine"
 Close #10
 Exit Function

fnBulkInsertTab_Error_Routine:
 Open sErrFilename For Output As #9
 Print #9, "Error Log - 15th May 2014"
 Print #9, Now()
 Print #9, Err.Number
 Print #9, Err.Description
 Print #9, CurrentDb.Name
 Print #9, "fnBulkInsertTab"
 Print #9, sSQL01
 Print #9, sSQL02
 Print #9, "**END**"

 Close #9
 Resume fnBulkInsertTab_Exit_Routine

End_Function:
End Function

Public Function fnTableExists(sTablename As String) As Boolean
 On Error GoTo Exit_Function
 fnTableExists = False
 If IsObject(CurrentDb.TableDefs(sTablename)) Then fnTableExists = True
Exit_Function:
End Function