將帶有超過255個字段的製表符分隔的txt文件導入到兩個Access表中的工作代碼

Question

以下代碼將帶有255個字段的製表符分隔文件導入到兩個表中。只要確保在設計兩個表格時，所有字段對於正在導入的字段都具有正確的數據類型。我最初使用Access導入文本文件嚮導創建了我的表。在使用嚮導之前，我刪除了255之後的字段以創建第一個表格，然後刪除第一個255來創建第二個表格。希望這可以幫助某人，並感謝以下幫助我完成此項目的每個人。

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 

Answer 1

我承認，你想在這裏做什麼已經不太理想。我不需要經常處理需要這麼多領域的數據。

這裏的解決方案基本上是管理兩個不同的記錄集對象。

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