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

- Coder375

---

+1 好问题 :) 你差点让我产生了思考！ - Siddharth Rout

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

- tbur

---

+1 简直太美妙了！ - Siddharth Rout

如果你的网络连接缓慢或者有很多文件，使用dir命令并通过exec运行在本地机器上也不会更快。dir命令在内部进行迭代，而通过exec运行它意味着它会受到相同的网络延迟影响。 - Ken White

@KenWhite 如果将上述代码放入批处理文件中，然后将该文件复制到远程文件夹中，然后再从那里运行呢？ - Siddharth Rout

@SiddharthRout：除非您使用rexec或类似的东西，否则它仍将在本地计算机上运行并通过网络检索列表。然而，问题不是关于在远程计算机上运行进程然后传输文件，而是关于检索目录列表而不进行迭代，这是不可能的。 （Raymond Chen撰写了一系列有关此问题的文章，与Explorer在慢速网络连接上检索文件列表有关，但我手头没有链接。） - Ken White

@KenWhite：嗯，如果不通过网络检索列表，而是将列表输出到远程文件夹中的文本文件中，然后再检索该文本文件呢？ - Siddharth Rout

Answer 2

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

这个函数接受一个类似于"c:\windows\"的路径，并返回该文件夹中所有文件（和目录）的集合。我使用的确切参数需要Windows 7或更新版本，请参见声明中的注释。

'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

- Coder375

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

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

- Siddharth Rout

---

这仍然从本地计算机运行dir命令，并请求网络上的文件列表。通过cmd.exe运行它仍然在本地执行。您需要复制批处理文件或脚本到网络上，使用rexec或类似工具远程执行它，然后在该远程进程完成后跨网络传输结果文件（这意味着您必须等待并轮询以确保其完成）。 - Ken White

是的，但我猜这可能是OP目前唯一的选择？ - Siddharth Rout

这不会是一种改进。:-) 通过 rexec 启动文件的开销、轮询，然后传输文本文件（然后解析文本文件以获取文件列表）将对性能产生影响。 - Ken White

我突然想到一个问题……如果我们提供 cmd（该机器的）的完整路径，这样它就不会从本地机器运行 cmd 了，你觉得怎么样？ - Siddharth Rout

@SiddharthRout：谢谢您的回答，但是我无法使用CMD，请查看我对上面答案的评论。 - Coder375