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

耗尽温柔 提交于 2019-12-13 04:32:34

问题


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

回答1:


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


来源:https://stackoverflow.com/questions/17975454/working-code-to-import-tab-delimited-txt-file-with-more-than-255-fields-into-two

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!