这对我很有用......它会提示对话框选择文件夹并打开 .pdf 文件。它还将列出 Table1 中的所有文件。
Option Compare Database
'函数选择文件所在的文件夹:
Function ChooseFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
输入例程以打开并列出文件夹中的 pdf 文件(它还会查找子文件夹中的文件):
Sub Open_List_Files()
'Declare the variables
Dim objFSO As Scripting.FileSystemObject
Dim objFolder, objTopFolder As Scripting.Folder
Dim strTopFolderName As String, ProjectF As String
Dim i As Long
' call the function to select the folder
Call Módulo1.ChooseFolder
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the top folder
Set objTopFolder = objFSO.GetFolder(ChooseFolder)
'Call the RecursiveFolder routine
Call RecursiveFolder(objTopFolder, True)
End Sub
Sub RecursiveFolder(objFolder As Scripting.Folder, IncludeSubFolders As Boolean)
'Declare the variables
Dim objFile As Object
Dim objSubFolder As Scripting.Folder
Dim DBStr, filepath As String
'Loop through each file in the folder
For Each objFile In objFolder.Files
On Error Resume Next
If InStr(objFile.Name, ".pdf") Then
DBStr = "INSERT INTO Table1 ([File Name]) " & _
" VALUES (" & _
"'" & objFile.Name & "', " & "');"
CurrentDb.Execute DBStr
'open the file
Application.FollowHyperlink objFile
End If
Next objFile
'Loop through files in the subfolders
If IncludeSubFolders Then
For Each objSubFolder In objFolder.SubFolders
Call RecursiveFolder(objSubFolder, True)
Next objSubFolder
End If
End Sub
运行 Open_List_Files() 宏就可以了!:)