通過傳輸文件導入時保留多個文件名

Question

Private Sub Command38_Click() 
    Dim f As Object 
    Dim db As DAO.Database 
    Dim qdf As DAO.QueryDef 
    Dim strUpdate As String 
    Dim strFile As String 
    Dim strFolder As String 
    Dim varItem As Variant 
    Dim P As String 
    Dim DeleteEverything As String 

     DoCmd.SetWarnings False 
     DeleteEverything = "DELETE * FROM [ucppltr]" 
     DoCmd.RunSQL DeleteEverything 
    Set f = Application.FileDialog(3) 
    f.AllowMultiSelect = True 
    f.InitialFileName = "S:\Formware\outfile\ucppt12\Storage" 
    f.Filters.Clear 
    f.Filters.Add " Armored TXT Files", "*.asc" 
     If f.Show Then 
     For Each varItem In f.SelectedItems 
      strFile = Dir(varItem) 
      strFolder = Left(varItem, Len(varItem) - Len(strFile)) 
      P = strFolder & strFile 
      DoCmd.TransferText acImportDelim, "UCPP Import Specification", "ucppltr", P, False 
     Next 
     End If 
    strUpdate = "PARAMETERS fileName Text;" & vbCrLf & _ 
    "UPDATE ucppltr" & vbCrLf & _ 
    "Set [File Name] = fileName" 
    Debug.Print strUpdate 
    Set db = CurrentDb 
    Set qdf = db.CreateQueryDef("", strUpdate) 
    qdf.Parameters("fileName") = strFile 
    qdf.Execute dbFailOnError 
    Set qdf = Nothing 
    Set db = Nothing 
    Set f = Nothing 

    MsgBox DCount("*", "ucppltr") & " Records were imported" 
End Sub 

正如您從導入代碼中所看到的，我希望存儲文件名並在它能夠工作時無法正常工作，而這正是我需要的。當我們爲這個客戶端工作時，每週有5個文件每週吃一次，所以我希望它保存所有5個文件名，但它只保存它導入的最後一個文件。我的問題是，有沒有辦法將每個文件名保存到每個文件名中（我懷疑），還是可以將全部5個文件名保存到我導入的所有記錄中，而不僅僅保存最後一個文件名？

我總是可以選擇只允許單次導入並將它們導入並追加表格5次我只想在檢查之前檢查是否有更有效的方法。

在此事先感謝您的幫助！

Answer 1

您的邏輯存在問題。在循環內部，strFile保存當前文件名。因此，在循環完成後，只有當前（=最後一個）文件名被傳遞給查詢。

我做了一些更改，所以文件名現在存儲在新變量strFileList中，由「;」分隔。請檢查，如果這是一個可行的解決方案。

Private Sub Command38_Click() 
Dim f As Object 
Dim db As DAO.Database 
Dim qdf As DAO.QueryDef 
Dim strUpdate As String 
Dim strFile As String 
Dim strFolder As String 
Dim varItem As Variant 
Dim P As String 
Dim DeleteEverything As String 

' Variable to hold file list 
Dim strFileList As String 

    DoCmd.SetWarnings False 
    DeleteEverything = "DELETE * FROM [ucppltr]" 
    DoCmd.RunSQL DeleteEverything 
Set f = Application.FileDialog(3) 
f.AllowMultiSelect = True 
f.InitialFileName = "S:\Formware\outfile\ucppt12\Storage" 
f.Filters.Clear 
f.Filters.Add " Armored TXT Files", "*.asc" 
    If f.Show Then 
    For Each varItem In f.SelectedItems 
     strFile = Dir(varItem) 
     strFolder = Left(varItem, Len(varItem) - Len(strFile)) 
     P = strFolder & strFile 
     DoCmd.TransferText acImportDelim, "UCPP Import Specification", "ucppltr", P, False 

     'Add file name to file list 
     strFileList = strFileList & strFile & ";" 
    Next 
    End If 
strUpdate = "PARAMETERS fileName Text;" & vbCrLf & _ 
"UPDATE ucppltr" & vbCrLf & _ 
"Set [File Name] = fileName" 
Debug.Print strUpdate 
Set db = CurrentDb 
Set qdf = db.CreateQueryDef("", strUpdate) 

'Pass file list to query 
qdf.Parameters("fileName") = strFileList 

qdf.Execute dbFailOnError 
Set qdf = Nothing 
Set db = Nothing 
Set f = Nothing 

MsgBox DCount("*", "ucppltr") & " Records were imported" 
End Sub