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

时间:2013-07-19 10:28:24

标签: vba ms-access ms-access-2007 access-vba

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次我只是想检查一下是否有更好的方法。

提前感谢您对此事的任何帮助!

1 个答案:

答案 0 :(得分:1)

您的逻辑存在问题。在循环内部,strFile保存当前文件名。因此,在完成循环后,只将当前(= last)文件名传递给查询。

我做了一些更改,因此文件名现在存储在新变量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