我在弄清楚如何获取文件夹名称以输出到MS access中的单独字段时遇到麻烦。到目前为止，我已经设法使用了Allen Browne脚本并将其调整为将文件名和路径输出为一个字段。

此搜索中的所有文件都包含在子文件夹中，对于我而言，在单独的字段中输出最后一个子文件夹名称非常重要。像这样：

代码如下：

Option Compare Database
Option Explicit

'list files to tables
'http://allenbrowne.com/ser-59alt.html

Dim gCount As Long ' added by Crystal

Sub runListFiles()
    'Usage example.
    Dim strPath As String _,strFileSpec As String _,booIncludeSubfolders As Boolean

    strPath = "H:\Pictures\2019"
    strFileSpec = "*.*"
    booIncludeSubfolders = True

    ListFilesToTable strPath,strFileSpec,booIncludeSubfolders
End Sub

'crystal modified parameter specification for strFileSpec by adding default value
Public Function ListFilesToTable(strPath As String _,Optional strFileSpec As String = "*.*" _,Optional bIncludeSubfolders As Boolean _
    )
On Error GoTo Err_Handler
    'Purpose:   List the files in the path.
    'Arguments: strPath = the path to search.
    '           strFileSpec = "*.*" unless you specify differently.
    '           bIncludeSubfolders: If True,returns results from subdirectories of strPath as well.
    'Method:    FilDir() adds items to a collection,calling itself recursively for subfolders.

    Dim colDirList As New Collection
    Dim varitem As Variant
    Dim rst As DAO.Recordset

   Dim mStartTime As Date _,mSeconds As Long _,mMin As Long _,mMsg As String

   mStartTime = Now()
   '--------

    Call FillDirToTable(colDirList,strPath,bIncludeSubfolders)

   mSeconds = DateDiff("s",mStartTime,Now())

   mMin = mSeconds \ 60
   If mMin > 0 Then
      mMsg = mMin & " min "
      mSeconds = mSeconds - (mMin * 60)
   Else
      mMsg = ""
   End If

   mMsg = mMsg & mSeconds & " seconds"

   MsgBox "Done adding " & Format(gCount,"#,##0") & " files from " & strPath _
      & IIf(Len(Trim(strFileSpec)) > 0," for file specification --> " & strFileSpec,"") _
      & vbCrLf & vbCrLf & mMsg,"Done"

Exit_Handler:
   SysCmd acSysCmdClearStatus
   '--------

    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description,"ERROR"

    'remove next line after debugged -- added by Crystal


    Resume Exit_Handler
End Function

Private Function FillDirToTable(colDirList As Collection _,ByVal strFolder As String _,bIncludeSubfolders As Boolean)

    'Build up a list of files,and then add add to this list,any additional folders
    On Error GoTo Err_Handler

    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    Dim strSQL As String

    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
         gCount = gCount + 1
         SysCmd acSysCmdSetStatus,gCount
         strSQL = "INSERT INTO Files " _
          & " (FPath) " _
          & " SELECT """ & strFolder & """" _
          & "& """ & strTemp & """;"
         CurrentDb.Execute strSQL
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop

    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        strTemp = Dir(strFolder,vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (Getattr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDirToTable(colDirList,strFolder & TrailingSlash(vFolderName),True)
        Next vFolderName
    End If

Exit_Handler:

    Exit Function

Err_Handler:
    strSQL = "INSERT INTO Files " _
    & " (FPath) " _
    & " SELECT ""  ~~~ ERROR ~~~""" _
    & ",""" & strFolder & """;"
    CurrentDb.Execute strSQL

    Resume Exit_Handler
End Function

Public Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn,1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function