Search code examples
ms-accessimportvbaadoflat-file

Working code to import tab delimited txt file with more than 255 fields into two Access Tables


This code below will import a tab delimited file with over 255 fields into two tables. Just make sure when you design your two tables all your fields have the correct data types for the fields being imported. I originally created my tables by using Access import text file wizard. Before using the wizard I deleted the fields after 255 to create the first table and then deleted the first 255 to create the second table. Hopes this helps someone and thanks to everyone below who helped me with this project.

Public Sub ImportTextFile()
   ' to use the ADODB.Recordset, be sure you have a reference set to ADO
   Dim rst As ADODb.Recordset
   Dim rst2 As ADODb.Recordset
   Dim strFile As String
   Dim strInput As String
   Dim varSplit As Variant
   Dim intCount As Integer

   Set rst = New ADODb.Recordset
   Set rst2 = New ADODb.Recordset
   ' CHANGE THE TABLE NAME HERE
   rst.Open "AppsImport1", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
   rst2.Open "AppsImport2", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
   ' CHANGE THE TEXT FILE NAME AND LOCATION HERE
   strFile = "G:\Home\RiskMgtReports\AutoDatabase\CreditAppExtract.txt"

   Open strFile For Input As #1

   Dim i As Integer
   Dim n As Long

   n = DMax("index_number", "fullextract_hist")

   Do Until EOF(1)
       ' This counter is just to get to the applicable line before importing
       intCount = intCount + 1
       ' reads the text file line by line
       Line Input #1, strInput
       ' starts importing on the second line.  Change the number to match which line you
       ' want to start importing from
       If intCount >= 2 Then
       n = n + 1
           ' creates a single dimension array using the split function
           varSplit = Split(strInput, vbTab, , vbBinaryCompare)
           ' adds the record
           With rst
               .AddNew
               .Fields(0) = n
                For i = 1 To 137
                    If Nz(varSplit(i - 1), "") = "" Then
                    .Fields(i) = Null
                    Else
                    If Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Jan M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Feb M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Mar M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Apr M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "May M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Jun M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Jul M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Aug M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Sep M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Oct M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Nov M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Dec M" Then
                    .Fields(i) = CDate(Format(varSplit(i - 1), "mm/dd/yyyy"))
                    Else
                    .Fields(i) = varSplit(i - 1)
                    End If
                    End If
                Next i
               .Update
               '.MoveNext 'I don't think you should need this
           End With
           With rst2
                .AddNew
                .Fields(0) = n
                .Fields(1) = varSplit(0)
                For i = 138 To 274
                    If Nz(varSplit(i - 1), "") = "" Then
                    .Fields(i - 136) = Null
                    Else
                    If Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Jan M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Feb M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Mar M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Apr M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "May M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Jun M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Jul M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Aug M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Sep M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Oct M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Nov M" Or Left(varSplit(i - 1), 4) & Right(Trim(varSplit(i - 1)), 1) = "Dec M" Then
                    .Fields(i - 136) = CDate(Format(varSplit(i - 1), "mm/dd/yyyy"))
                    Else
                    .Fields(i - 136) = varSplit(i - 1)
                    End If
                    End If
                Next i
                .Update
            End With
       End If
   Loop
   ' garbage collection
   Close #1
   rst.Close
   Set rst = Nothing
   rst2.Close
   Set rst2 = Nothing

End Sub

Solution

  • I admit that what you're trying to do here is already less than ideal. I don't often work with data where this many fields are needed.

    The solution here is basically to manage two different recordset objects.

    Public Sub ImportTextFile()
       ' to use the ADODB.Recordset, be sure you have a reference set to ADO
       Dim rst As ADODb.Recordset
       Dim rst2 As ADODb.Recordset
       Dim strFile As String
       Dim strInput As String
       Dim varSplit As Variant
       Dim intCount As Integer
    
       Set rst = New ADODb.Recordset
       Set rst2 = New ADODb.Recordset
       ' CHANGE THE TABLE NAME HERE
       rst.Open "Importtabledata", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
       rst2.Open "importtabledata2", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
       ' CHANGE THE TEXT FILE NAME AND LOCATION HERE
       strFile = "G:\Home\RiskMgtReports\AutoDatabase\fullextract.txt"
    
       Open strFile For Input As #1
    
       Dim i as Integer
    
       Do Until EOF(1)
           ' This counter is just to get to the applicable line before importing
           intCount = intCount + 1
           ' reads the text file line by line
           Line Input #1, strInput
           ' starts importing on the second line.  Change the number to match which line you
           ' want to start importing from
           If intCount >= 256 Then
               ' creates a single dimension array using the split function
               varSplit = Split(strInput, vbTab, , vbBinaryCompare)
               ' adds the record
               With rst
                   .AddNew
                    For i = 1 to 255
                        .Fields(i) = varSplit(i-1)
                    Next i
                   .Update
                   '.MoveNext 'I don't think you should need this
               End With
               With rst2
                    .AddNew
                    For i = 256 to UBound(varSplit)
                        .Fields(i) = varSplit(i-1)
                    Next i
                    .Update
                End With
           End If
       Loop
       ' garbage collection
       Close #1
       rst.Close
       Set rst = Nothing
       rst2.Close
       Set rst2 = Nothing
    
    End Sub