通过传输文件导入时保留多个文件名

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