Excel VBA高效获取文件名功能

Question

我需要在 excel 2010 中使用 VBA 从远程服务器上的文件夹中获取文件名集合。我有一个可以工作的功能，在大多数情况下它可以完成这项工作，但是远程服务器经常很糟糕，可怕的网络性能问题。这意味着循环遍历 300 个文件以将其名称放入一个集合可能需要 10 分钟，文件夹中的文件数量可能会增长到数千个，因此这是行不通的，我需要一种获取所有文件名的方法在单个网络请求中而不是循环。我相信它连接到需要时间的远程服务器，因此单个请求应该能够相当快地一次性获取所有文件。

这是我目前拥有的功能：

Private Function GetFileNames(sPath As String) As Collection
'takes a path and returns a collection of the file names in the folder

Dim oFolder     As Object
Dim oFile       As Object
Dim oFSO        As Object
Dim colList     As New Collection

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(folderpath:=sPath)

For Each oFile In oFolder.Files
    colList.Add oFile.Name
Next oFile

Set GetFileNames = colList

Set oFolder = Nothing
Set oFSO = Nothing

End Function

Answer 1

这个速度快如闪电：

  Sub filesTest()
    Dim x() As String
    x = Function_FileList("YOUR_PATH_AND_FOLDER_NAME")
    Debug.Print Join(x, vbCrLf)
  End Sub

调用这个函数：

 Function Function_FileList(FolderLocation As String)
    Function_FileList = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & FolderLocation & """ /b /a-d").stdout.readall, vbCrLf), ".")
 End Function

Answer 2

好的，我找到了适合我情况的解决方案，也许其他人也会觉得它有用。此解决方案使用 Windows API 并在 1 秒或更短的时间内为我获取文件名，而 FSO 方法需要几分钟。它仍然涉及一个循环，所以我不确定为什么它会这么快，但确实如此。

这采用类似“c:\windows\”的路径并返回该文件夹中所有文件（和目录）的集合。我使用的确切参数需要 Windows 7 或更高版本，请参阅声明中的 cmets。

'for windows API call to FindFirstFileEx
Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260

Private Type FILETIME
    dwLowDateTime   As Long
    dwHighDateTime  As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes    As Long
    ftCreationTime      As FILETIME
    ftLastAccessTime    As FILETIME
    ftLastWriteTime     As FILETIME
    nFileSizeHigh       As Long
    nFileSizeLow        As Long
    dwReserved0         As Long
    dwReserved1         As Long
    cFileName           As String * MAX_PATH
    cAlternate          As String * 14
End Type

Private Const FIND_FIRST_EX_CASE_SENSITIVE  As Long = 1
'MSDN: "This value is not supported until Windows Server 2008 R2 and Windows 7."
Private Const FIND_FIRST_EX_LARGE_FETCH     As Long = 2

Private Enum FINDEX_SEARCH_OPS
    FindExSearchNameMatch
    FindExSearchLimitToDirectories
    FindExSearchLimitToDevices
End Enum

Private Enum FINDEX_INFO_LEVELS
    FindExInfoStandard
    FindExInfoBasic 'MSDN: "This value is not supported until Windows Server 2008 R2 and Windows 7."
    FindExInfoMaxInfoLevel
End Enum

Private Declare Function FindFirstFileEx Lib "kernel32" Alias "FindFirstFileExA" ( _
ByVal lpFileName As String, ByVal fInfoLevelId As Long, lpFindFileData As WIN32_FIND_DATA, _
    ByVal fSearchOp As Long, ByVal lpSearchFilter As Long, ByVal dwAdditionalFlags As Long) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
    ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long


Private Function GetFiles(ByVal sPath As String) As Collection

    Dim fileInfo    As WIN32_FIND_DATA  'buffer for file info
    Dim hFile       As Long             'file handle
    Dim colFiles    As New Collection

    sPath = sPath & "*.*"

    hFile = FindFirstFileEx(sPath & vbNullChar, FindExInfoBasic, fileInfo, FindExSearchNameMatch, 0&, FIND_FIRST_EX_LARGE_FETCH)

    If hFile <> INVALID_HANDLE_VALUE Then
        Do While FindNextFile(hFile, fileInfo)
            colFiles.Add Left(fileInfo.cFileName, InStr(fileInfo.cFileName, vbNullChar) - 1)
        Loop

        FindClose hFile
    End If

    Set GetFiles = colFiles

End Function

Answer 3

我认为会有一个 API 可以让我在不循环的情况下获取目录中的文件名，但找不到它。我知道的所有代码都涉及使用fso 或dir 循环。

那么是否可以在不循环的情况下获取文件名。我想是的...这是我能想到的一种方法...

当您在 DOS 提示符下键入以下命令时，整个文件结构将发送到一个文本文件中

Dir C:\Temp\*.* > C:\Temp\MyFile.Txt

从 VBA 执行上述操作

Sub Sample()
    Dim sPath As String

    sPath = "C:\Temp\"

    '~~> DIR C:\Temp\*.* > C:\Temp\MyFile.txt
    retval = Shell("cmd.exe /c Dir " & sPath & "*.* > " & sPath & "MyFile.Txt")
End Sub

例如（这是存储在 MyFile.Txt 中的内容）

Volume in drive C is XXXXXXX
Volume Serial Number is XXXXXXXXX

Directory of C:\Temp

10/08/2014  11:28 PM    <DIR>          .
10/08/2014  11:28 PM    <DIR>          ..
10/08/2014  11:27 PM               832 aaa.txt
10/08/2014  11:28 PM                 0 bbb.txt
10/08/2014  11:26 PM                 0 New Bitmap Image.bmp
10/08/2014  11:26 PM                 0 New Bitmap Image_2.bmp
10/08/2014  11:26 PM                 0 New Bitmap Image_2_2.bmp
10/08/2014  11:26 PM                 0 New Bitmap Image_3.bmp
10/08/2014  11:26 PM                 0 New Bitmap Image_3_2.bmp
10/08/2014  11:26 PM                 0 New Bitmap Image_4.bmp
10/08/2014  11:26 PM                 0 New Bitmap Image_4_2.bmp
10/08/2014  11:26 PM                 0 New Bitmap Image_5.bmp
            10 File(s)            832 bytes
             2 Dir(s)  424,786,952,192 bytes free

所以现在您需要做的就是将文本文件从远程文件夹复制到您的文件夹，然后简单地解析它以获取文件名。