Import a text file as a table in MS Access using VBA

MS Access is easily the best-suited software tool for manipulating, cleansing and transforming extracts from legacy systems prior to loading into SAP. This function automatically determines the format of the text file and creates a table based on the structure of the text data. It can even import extracts created using the SE16 transaction in SAP without any additional steps.

Importing extracts into Access is an easy enough task and should be included in a macro so that the step is never forgotten. Creating a specification while importing the file the first time allows it to be repeatedly imported just so long as the format never changes. Often the field names, field order or delimiter is changed then Access can't interpret the source file; catastrophe ensues. Using this function to automatically define the table structure and then import each row of the source data reduces the risk of errors caused by constantly changing extract formats.

The power of macros

So often data comes from a legacy system in a format that is far removed from the ideal format required. Sometimes dozens of small changes are required to ensure that the format of the data is correct and might include things like correcting number, currency, date and time formats, separating the house number from the street name, fixing capitalization, padding numbers with leading zeros and concatenating, splitting and trimming text values. Rather than remembering each step or creating a list of steps to perform manually one can create a macro in MS Access to run a series of functions, queries and commands to automatically transform the data. Over the course of a project macros grow organically and resemble Rube Goldberg machines, but the end project is consistently transformed data that meets expectations.

The source code

This function has itself grown organically over time with small tweaks and upgrades added to meet requirements. Only last year was the ability to detect and handle extracts produced by SE16 added. The meter was added in 2004 because the network connection to the file server in another country was so slow that the system appeared to hang for minutes while a single text file was imported; now Access updates the progress bar as the file is imported.

Prior to 2011 the function created every field as text with a length of 255 characters. The read-ahead capability added the ability to predict the optimal field length and save space in the Access file which still has just a 2GB size limitation.

There is a supplementary function CreateTable() that actually creates the table in Access based on parameters passed in from ImportFromText(). It is important that the supplementary function be included in the Access database, but not necessarily in the same module.

Function ImportFromText(strTableName As String, strFileName As String, Optional ByVal strDelim As String = vbTab) As Boolean
    'This function is used to import delimited files, not fixed-width.  
    'SAP extracts are pipe-delimited and are identified automatically.

    Dim rs As DAO.Recordset
    Dim nCurrent As Long, nFieldCount As Long, nRecordCount As Long
    Dim RetVal As Variant, nCurRec As Long, dnow As Date, nCurSec As Long
    Dim nTotalSeconds As Long, nSecondsLeft As Long
    Dim nTotalbytes As Long, nFileLen As Long
    Dim strTest As Variant
    Dim strTemp As String
    Dim strHeadersIn() As String
    Dim strHeaders(999) As String
    Const nReadAhead As Long = 30000
    Dim nSizes(999) As Long, strRecords(nReadAhead) As String, nRecords As Long, nLoaded As Long
    Dim strFields() As String
    
    Dim nHeaders As Long
    Dim isSAP As Boolean
    
    nFileLen = FileLen(strFileName)
    RetVal = SysCmd(acSysCmdSetStatus, "Preparing to import " & strTableName & " from " & strFileName & "...")
    RetVal = DoEvents()
    
    Open strFileName For Input As #1
    Line Input #1, strTest
    If Left(strTest, 6) = "Table:" Then 'This is an SAP extract!
        isSAP = True
        Line Input #1, strTest
        Line Input #1, strTest
        Line Input #1, strTest  'Fourth line has the headers!
    Else
        isSAP = False
    End If
    
    If InStr(1, strTest, "|", vbTextCompare) Then
        strDelim = "|"
    End If
    
    nTotalbytes = nTotalbytes + Len(strTest) + 2 ' +2 for vbCrLf--This line prevents div by zero later...
    strTest = Trim(strTest)
    If Right(strTest, 1) = strDelim Then
        strTest = Left(strTest, Len(strTest) - 1)
    End If
    strHeadersIn = Split(Trim(strTest), strDelim)
    nHeaders = 0
    
    
    For Each strTest In strHeadersIn
        nHeaders = nHeaders + 1
        strTest = Replace(Replace(strTest, " ", ""), ".", "")
        strTest = Replace(Replace(strTest, " ", ""), ".", "")
        If Len(Trim(strTest)) = 0 Then
            strHeaders(nHeaders) = "HEADER" & Right("000" & nHeaders, 3)
        Else
            strHeaders(nHeaders) = Trim(strTest)
        End If
        For nCurrent = 1 To nHeaders - 1
            If strHeaders(nHeaders) = strHeaders(nCurrent) Then
                strHeaders(nHeaders) = strHeaders(nHeaders) & nHeaders
            End If
        Next
    Next
    strHeaders(0) = nHeaders
    RetVal = SysCmd(acSysCmdClearStatus)
    RetVal = SysCmd(acSysCmdInitMeter, "Preparing to import " & strTableName & " from " & strFileName & "...", nReadAhead)
    RetVal = DoEvents()
    
    Do While Not EOF(1) And nRecords < nReadAhead 'Read through the file and get the maximum sizes for fields in advance.
        Line Input #1, strTest
        strTest = Trim(strTest)
        If Right(strTest, 1) = strDelim Then
            strTest = Left(strTest, Len(strTest) - 1)
        End If
        If isSAP And Left(strTest, 20) = "--------------------" Then
            strTest = ""  'Skip this line!
        End If
        If Len(strTest) > 0 Then
            nRecords = nRecords + 1
            strRecords(nRecords) = strTest
            strFields = Split(strTest, strDelim)
            nCurrent = 0
            For Each strTest In strFields
                nCurrent = nCurrent + 1
                If Len(strTest) > nSizes(nCurrent) Then
                    nSizes(nCurrent) = Len(strTest)
                End If
            Next
            If Second(Now) <> nCurSec Then
                nCurSec = Second(Now)
                RetVal = SysCmd(acSysCmdUpdateMeter, nRecords)
                RetVal = DoEvents()
            End If
        End If
    Loop
    
    
    If CreateTable(strTableName, strHeaders, nSizes) Then
        If isSAP Then
            For nCurrent = 1 To nHeaders
                If Left(strHeaders(nCurrent), 8) = "HEADER00" Then
                    strHeaders(nCurrent) = ""  'Don't bother importing this field.
                End If
            Next
        End If
        Set rs = CurrentDb.OpenRecordset(strTableName)
        nLoaded = 0
        nTotalSeconds = 0
        Do While Not EOF(1) Or nLoaded < nRecords
            nCurRec = nCurRec + 1
            If Second(Now()) <> nCurSec Then
                nCurSec = Second(Now())
                nTotalSeconds = nTotalSeconds + 1
                'RetVal = DoEvents()
                If nTotalSeconds > 3 Then
                    'nSecondsLeft = Int(((nTotalSeconds / nCurRec) * rs.RecordCount) * ((rs.RecordCount - nCurRec) / rs.RecordCount))
                    nSecondsLeft = Int(((nTotalSeconds / nTotalbytes) * nFileLen) * ((nFileLen - nTotalbytes) / nFileLen))
                    RetVal = SysCmd(acSysCmdRemoveMeter)
                    RetVal = SysCmd(acSysCmdInitMeter, "Importing " & strTableName & " from " & strFileName & "... " & nSecondsLeft & " seconds remaining.", nFileLen)
                    RetVal = SysCmd(acSysCmdUpdateMeter, nTotalbytes)
                    RetVal = DoEvents()
                End If
            End If
            If nLoaded < nRecords Then
                nLoaded = nLoaded + 1
                strTest = strRecords(nLoaded)
            Else
                Line Input #1, strTest
            End If
            nTotalbytes = nTotalbytes + Len(strTest) + 2 'vbCrLf
            strTest = Trim(strTest)
            If Right(strTest, 1) = strDelim Then
                strTest = Left(strTest, Len(strTest) - 1)
            End If
            If isSAP And Left(strTest, 20) = "--------------------" Then
                strTest = ""  'Skip this line!
            End If
            If Len(strTest) > 0 Then
                strFields = Split(strTest, strDelim)
                nCurrent = 0
                rs.AddNew
                For Each strTest In strFields
                    nCurrent = nCurrent + 1
                    If Len(Trim(strHeaders(nCurrent))) > 0 Then
                        rs.Fields(strHeaders(nCurrent)).Value = Trim(strFields(nCurrent - 1))
                    End If
                Next
                rs.Update
            End If
        Loop
        rs.Close
    End If
    Close #1
    RetVal = SysCmd(acSysCmdRemoveMeter)
End Function


Function CreateTable(strTableName As String, strFields() As String, nSizes() As Long) As Boolean
    Dim nCounter As Long
    Dim dbs As DAO.Database
    'Now create the database.  Rename the old database if necessary.
    Set dbs = CurrentDb
    Dim tdf As DAO.TableDef
    Dim fld1 As DAO.Field
    Dim fld2 As DAO.Field
    Dim fName As String
    Dim fType As Integer
    Dim fSize As Integer
    
    On Error GoTo ErrorHandler
    'Check for existence of TargetTable
    nCounter = 0
    Do While nCounter < dbs.TableDefs.Count
        If dbs.TableDefs(nCounter).Name = strTableName Then
            'Delete TargetTable--must start from scratch
            dbs.TableDefs.Delete (strTableName)
        End If
        nCounter = nCounter + 1
    Loop
    
    Set tdf = dbs.CreateTableDef(strTableName)
    For nCounter = 1 To Val(strFields(0))
        fName = strFields(nCounter)
        fType = dbText  'Never encounter type-mismatch if we always use text.
        fSize = nSizes(nCounter) 'fSize = 255
        Set fld1 = tdf.CreateField(fName, fType, fSize)
        fld1.AllowZeroLength = True
        fld1.Required = False
        tdf.Fields.Append fld1
    Next
    'Create the table in the database
    dbs.TableDefs.Append tdf
    dbs.TableDefs.Refresh
    CreateTable = True
    Exit Function
ErrorHandler:
    MsgBox "Error number " & Err.Number & ": " & Err.Description
    CreateTable = False
    Exit Function
End Function