Domanda

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
È stato utile?

Soluzione

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
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top