Access VBA：导入多个文件时添加“文件名”字段

Posted 2023-05-06

【中文标题】Access VBA：导入多个文件时添加“文件名”字段

【英文标题】：Access VBA: Adding 'filename' field when importing multiple files

【发布时间】：2016-12-14 04:19:37

【问题描述】：

我有一些工作代码循环遍历一个充满 Excel 文件的文件夹，并将每个表中的一个表导入到 Access 表中。我要做的只是在表的末尾添加一个名为 FileName 的字段，该字段具有源 Excel 文件的名称。

我做了一些谷歌搜索并找到了这个解决方案： How to add file name when importing multiple Excel files to one Access table

我尝试将解决方案合并到我的代码中，但是当我到达执行语句时，我得到：

运行时错误“3061”参数太少。预计 2。

我认为问题出在strSQL 语句和/或我最后执行它的方式上。

Public Sub Command0_Click()

Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
Dim qdf As DAO.QueryDef

Set db = CurrentDb()
'make the UPDATE a parameter query ...
strSQL = "UPDATE Test SET FileName=[pFileName] WHERE FileName Is Null OR
FileName='';"
Set qdf = db.CreateQueryDef(vbNullString, strSQL)

path = "C:\Users\u005984\Desktop\Test\"

'Loop through the folder & build file list
strFile = Dir(path & "*.xlsx")

While strFile <> ""
   'add files to the list
   intFile = intFile + 1
   ReDim Preserve strFileList(1 To intFile)
   strFileList(intFile) = strFile
   strFile = Dir()
Wend

'see if any files were found
If intFile = 0 Then
    MsgBox "No files found"
    Exit Sub
End If

'cycle through the list of files
For intFile = 1 To UBound(strFileList)
    filename = path & strFileList(intFile)
    DoCmd.TransferSpreadsheet acImport, 9, "Test", filename, True

    'Add filename field
    qdf.Parameters("pFileName").Value = strFileList(intFile)
    qdf.Execute dbFailOnError   
Next intFile

End Sub

我是 Access VBA 和 SQL 的新手，不知道为什么它需要 2 个参数。感谢您的帮助。

【问题讨论】：

在我的脑海中，尝试从 strSQL 查询的末尾删除分号。除此之外，我很想知道在执行之前qdf.Parameters.Count 是什么。

【参考方案1】：

调整你的 SQL 查询，你的不包含参数。

strSQL = "PARAMETERS pfilename Text ( 255 ); UPDATE Test SET FileName=[pFileName] WHERE FileName Is Null OR FileName='';"

【参考方案2】：

添加 FileName 字段与更新其值明显不同。因此，您需要两个 SQL 操作查询：ALTER 和 UPDATE 语句。

具体来说，查询需要引擎未知的两个组件：FileName 列和[pFileName] 参数值。很可能，您的 Excel 工作表没有将 FileName 列导入到 Test 表中。

考虑在循环中使用ALTER 语句的以下设置（仅在第一次迭代时，因为所有工作表都附加到同一个表）：

'Add filename field
For intFile = 1 To UBound(strFileList)    
    filename = path & strFileList(intFile)
    DoCmd.TransferSpreadsheet acImport, 9, "Test", filename, True

    If intFile = 1 then
       ' ALTER TABLE
       CurrentDb.Execute "ALTER TABLE [Test] ADD COLUMN [FileName] TEXT(255)", dbFailOnError
    End If

    ' UPDATE TABLE (PASSING PARAM VALUE)
    qdf.Parameters("pFileName").Value = strFileList(intFile)
    qdf.Execute dbFailOnError   
Next intFile