Import a text file as a linked table using VBA

Jimbo's picture

https://usercontent2.hubstatic.com/7521114_f260.jpg|https://usercontent2.hubstatic.com/7521087_f520.jpg|http://img.scoop.it/ZAUfhjn4fcSHYE1CZHHC2jl72eJkfbmt4t8yenImKBVvK0kTmF0xjctABnaLJIm9|https://s-media-cache-ak0.pinimg.com/564x/6e/da/4d/6eda4ded7de46ef76f40bc5c69f184c8.jpgOlder versions of MS Access have a 2GB file-size limitation. Without warning or explanation, Access will simply stop working and the database is rendered useless until the size is reduced. Handling large text file extracts from legacy systems as linked tables is an easy workaround for this problem, but managing linked tables is cumbersome unless every single revision of the extract is in the exact same format.

Linking to the text file rather than importing it presents a non-negligible performance hit. With modern computers linking doesn't have a significant impact on overall processing time, especially if the text file is on a local hard drive instead of a network share.

Pay no attention to that man behind the curtain.

There are a handful of hidden tables in MS Access that store settings we never think about. Three of them are used to store information about external data, specifically the specifications that define how access handles external data. These tables are:

MSysIMEXSpecs - Access uses this table to store formatting information about the file. The StartRow field stores a 1 if the first row has field names or 0 if not. A unique incremental numeric identifier is created for each new specification and is stored as SpecID in this table. Also stored here is the file type, file specification, the text indicator and the delimiters used for date, time and decimal.
MSysIMEXColumns - Access uses this table to store formatting and source information about the fields in the table and is linked to the MSysIMEXSpecs by the SpecID field. Each field is linked to a field in the text file and the field type is stored here. By default the text format is used for simplicity. Also stored here is the name of the field, the offset and length (for fixed-width data) and a flag for whether the field is skipped or not.
MSysObjects - This table holds the remainder of the information on the linked table like the folder where the file is located, the filename, the date when the table was created and the character set used. This table is not linked directly to the other two, but it mentions as part of the Data Source Name (DSN) the specification that is stored in MSysIMEXSpecs and MSysIMEXColumns tables.

The specification must be created by the function in order to ensure that the table has meaningful headers from the data and that each field is handled as text. MS Access defaults to "First row does not contain headers" and then makes intuitive guesses about the data types in each column, often guessing incorrectly. Then a table is created mentioning the specification that was created in it's DSN.

Added functionality and convenience

When data is touched by people it almost always changes. Creating a specification in Access is easy enough and, if the format, field order and location of the table never changed then it would be a one-time task. DBAs and internal resources don't always understand the need for consistency and, as a result, the data changes. Adding this function to an Access macro will ensure that the data is always available even if it isn't imported to Access as a table.

The source code

Copy and paste this into a new module in Access. I tested this in Access 2008 using DAO 3.6 without issue. When using older version of Access, be sure to add a reference to DAO. If you
like this code, feel free to look in our Snippits section for other great resources.

Function ImportFromTextToLink(strTableName As String, strFileName As String, Optional ByVal strDelim As String = vbTab) As Boolean
    'Written by Jimbo at SAPLSMW.com
    'NOTE: This function *only* works with delimited files, not fixed-width.
    Dim dbs As DAO.Database, tdf As DAO.TableDef, fld As DAO.Field
    Set dbs = CurrentDb
    Dim nCurrent As Long, nStart As Long, nWidth As Long
    Dim rs As DAO.Recordset, strHeaderRow As String, strFields() As String, strField As Variant
    Dim strSpecification As String, nSpecID As Integer, nNextSpecID As Integer
    
    'Read the header (first row) from the data. Ensures file exists!
    Open strFileName For Input As #1
    Line Input #1, strHeaderRow
    Close #1 'We only need the first line, so close it.
    
    'Check to see if the table already exists... Delete if it does.
    nCurrent = 0
    Do While nCurrent < dbs.TableDefs.Count
        If UCase(dbs.TableDefs(nCurrent).Name) = UCase(strTableName) Then
            dbs.TableDefs.Delete (strTableName)
        End If
        nCurrent = nCurrent + 1
    Loop
    
    'Now, work to create the link specification--delete if necessary.
    strSpecification = strTableName & " Link Specification"
    
    nSpecID = 0
    nNextSpecID = 1
    Set rs = dbs.OpenRecordset("SELECT * FROM MSysIMEXSpecs ORDER BY SpecID")
    isUpdated = False
    Do While Not rs.EOF
        If rs.Fields("SpecID").Value >= nNextSpecID Then
            nNextSpecID = rs.Fields("SpecID").Value + 1  'The next available SpecID
        End If
        If UCase(rs.Fields("SpecName").Value) = UCase(strSpecification) Then
            'Found it!  Just recycle this record.
            rs.Edit
            rs.Fields("DateDelim").Value = "/"          'Doesn't matter--we only import text
            rs.Fields("DateFourDigitYear").Value = True 'Doesn't matter--we only import text
            rs.Fields("DateLeadingZeros").Value = False 'Doesn't matter--we only import text
            rs.Fields("DateOrder").Value = 2            'Doesn't matter--we only import text
            rs.Fields("DecimalPoint").Value = "."       'Doesn't matter--we only import text
            rs.Fields("FieldSeparator").Value = strDelim
            'rs.Fields("FileType").Value = 437
            'rs.Fields("SpecID").Value = nSpecID        'Do not mess with this!
            'rs.Fields("SpecName").Value = strSpecification
            rs.Fields("SpecType").Value = "1"           'Link to text file
            rs.Fields("StartRow").Value = "1"           'Implies we have a header
            rs.Fields("TextDelim").Value = ""           'It's all text anyway!
            rs.Fields("TimeDelim").Value = ":"          'Doesn't matter--we only import text
            rs.Update 'Done!
            isUpdated = True 'Used as flag below to show we already updated.
            nSpecID = rs.Fields("SpecID").Value
        End If
        rs.MoveNext
    Loop
    If nSpecID = 0 Then 'Did not find existing record.
        nSpecID = nNextSpecID
        rs.AddNew
        rs.Fields("DateDelim").Value = "/"
        rs.Fields("DateFourDigitYear").Value = True
        rs.Fields("DateLeadingZeros").Value = False
        rs.Fields("DateOrder").Value = 2
        rs.Fields("DecimalPoint").Value = "."
        rs.Fields("FieldSeparator").Value = strDelim
        rs.Fields("FileType").Value = 437
        rs.Fields("SpecID").Value = nSpecID
        rs.Fields("SpecName").Value = strSpecification
        rs.Fields("SpecType").Value = "1"
        rs.Fields("StartRow").Value = "1"
        rs.Fields("TextDelim").Value = ""
        rs.Fields("TimeDelim").Value = ":"
        rs.Update 'Done!
    End If
    rs.Close
    
    'Specify all the columns and how they're handled.  We set the offset and length
    'even though the file is delimited and not fixed width.
    Set rs = dbs.OpenRecordset("MSysIMEXColumns")
    'First we delete any existing Secification Columns from our Specification
    Do While Not rs.EOF
        If rs.Fields("SpecID").Value = nSpecID Then
            rs.Delete
        End If
        rs.MoveNext
    Loop
    
    strFields = Split(strHeaderRow, strDelim)
    If strFields(UBound(strFields)) = "" Then
        'Often a delimiter is placed after the last header. We must ignore it.
        ReDim Preserve strFields(UBound(strFields) - 1)
    End If
    nStart = 1
    For Each strField In strFields
        nWidth = Len(strField) 'Set the width of the column.
        rs.AddNew
        rs.Fields("Attributes").Value = 0
        rs.Fields("DataType").Value = 10 'Who knows?
        rs.Fields("FieldName").Value = strField 'Simple enough.
        rs.Fields("IndexType").Value = 0 'Not indexed.
        rs.Fields("SkipColumn").Value = False
        rs.Fields("SpecID").Value = nSpecID
        rs.Fields("Start").Value = nStart 'Does not matter--not fixed width
        rs.Fields("Width").Value = nWidth 'Still does not matter.
        rs.Update
        nStart = nStart + nWidth 'Set the start of the next column.
    Next
    rs.Close 'MSysIMEXColumns
    
    Dim strConnect As String, strTableSource As String
    'Find the last \ in the file path...
    nCurrent = Len(strFileName)
    Do While nCurrent > 0 And Mid(strFileName, nCurrent, 1) <> "\"
        nCurrent = nCurrent - 1
    Loop
    strTableSource = Mid(strFileName, nCurrent + 1, Len(strFileName) - nCurrent) 'Filename

    Set tdf = dbs.CreateTableDef(strTableName)
    tdf.Name = strTableName
    strConnect = "Text;DSN=" & strSpecification & ";FMT=Delimited;HDR=NO;IMEX=2;CharacterSet=437;DATABASE=" & Left(strFileName, nCurrent - 1) 'Folder
    tdf.Connect = strConnect
    tdf.SourceTableName = strTableSource
    
    'Table has been defined, so add it to the database.
    dbs.TableDefs.Append tdf
    dbs.TableDefs.Refresh
    
    ImportFromTextToLink = True
End Function

Note: This function is included along with so many others as part of Jimbo's VBA Automation Toolbox. We do our best to maintain a repository of shared knowledge and to ensure that it is always available for free.

Programming Language: 
VBA