2013-07-24 78 views
1
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) 

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

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

正如您所看到的,我通常使用MultiSelect一次在5-6左右導入文本文件。我有一個文件名字段,並希望根據從中導入記錄的文件來填充它。到目前爲止,我只用最後一個文件名覆蓋前4個或5個,爲所有記錄提供相同的文件名。我不確定是否有辦法通過TransferText或其他任何方式填充導入區域。僅編輯表中的導入記錄

回答

1

修改您的UPDATE聲明以包含WHERE [File Name] Is Null

然後,在每個TransferText之後立即將當前文件名提供給UPDATE查詢並執行它。

strUpdate = "PARAMETERS fileName Text;" & vbCrLf & _ 
    "UPDATE ucppltr" & vbCrLf & _ 
    "Set [File Name] = fileName" & vbCrLf & _ 
    "WHERE [File Name] Is Null;" 
Debug.Print strUpdate 
Set db = CurrentDb 
Set qdf = db.CreateQueryDef("", strUpdate) 

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 
     'Pass file name to the query 
     qdf.Parameters("fileName") = strFile 
     qdf.Execute dbFailOnError 
    Next 
End If