Question

我创建了以下内容，将47个excel文件导入Access;所有具有相同命名约定的REPORT01，REPORT02等。

但是，我现在有一个名称不同的文件列表。有人可以建议我如何定制这个以适应变化吗？我原以为我可以用excel文件名创建一个单独的模块，主代码只是在它循环遍历文件夹时引用。如果找到匹配项，请导入。

Sub ImportTables()
' Define base path
Const cstrFolder As String = "F:\TCB_HR_KPI\Data View\"

Dim strExt As String
Dim strFile As String
Dim strTable As String
Dim i As Long
Dim fileCount As Long

' Check all 47 files exist
For i = 1 To 47
    strFile = cstrFolder & "REPORT" & Right("0" & i, 2) & ".xls"
    If Dir(strFile) <> "" Then fileCount = fileCount + 1
Next i

' Partial results allowed, only exit when no matches found
If fileCount = 0 Then
    MsgBox "Files not found"
    Exit Sub
End If

' Second loop to import data
fileCount = 0
For i = 1 To 47
    strFile = cstrFolder & "REPORT" & Right("0" & i, 2) & ".xls"
    If Dir(strFile) <> "" Then
        Debug.Print "Found: " & strFile
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "REPORT" & Right("0" & i, 2), strFile, True
        fileCount = fileCount + 1
    End If
Next i

MsgBox fileCount & " files imported."
End Sub

Answer 1

硬编码总是等待发生的灾难。我建议把这个基于表格。使用您的报告名称填充表格（即，假设您确切知道它们是什么），并打开该表格的记录集。然后，您可以循环遍历表并使用该文件名调用Import函数。

你可以放一个

On Error Resume

代码中的

语句，这样如果文件名不存在，它将只是移动到下一个。或者你可以在搜索实际文件夹的地方做一些复杂的事情。我没有时间修改它，但我使用的代码如下所示：

Dim fsoSysObj      As Scripting.FileSystemObject
Dim z
Dim fdrFolder      As Scripting.Folder
Dim fdrSubFolder   As Scripting.Folder
Dim filFile        As Scripting.File
'Dim strSQL As String

' Return new FileSystemObject.
Set fsoSysObj = New Scripting.FileSystemObject

' Get folder.
Set fdrFolder = fsoSysObj.GetFolder(strPath)

' Loop through Files collection
For Each filFile In fdrFolder.Files

您只需要在文件名表中对filFile.Name执行dLookup，看它是否存在。

导入多个Excel文件

1 个答案: