Excel VBA高效获取文件名function

我需要在Excel 2010中使用VBA从远程服务器上的文件夹获取文件集合。我有一个可以工作的function，在大多数情况下，它可以完成这项工作，但是远程服务器经常有可怕的， 可怕的networking性能问题。 这意味着循环说300文件将他们的名字到一个集合可能需要10分钟，该文件夹中的文件数量可能会增长到数千，所以这是行不通的，我需要一种方法来获取所有的文件名在一个单一的networking请求，而不是循环。 我相信它连接到远程服务器是花费时间，所以一个请求应该能够获得一个通过所有的文件很快。

这是我现在的function：

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 /ad").stdout.readall, vbCrLf), ".") End Function 

Answer 2

我以为会有一个API可以让我的文件名在一个目录没有循环，但无法find它。 我所知道的所有代码都涉及使用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 

所以现在你所要做的就是将文本文件从远程文件夹复制到你的文件夹，并简单地parsing它以获取文件名。

Answer 3

好吧，我已经find了适合我的情况的解决scheme，也许其他人也会觉得它有用。 这soution使用Windows API，并获取我的文件名在1秒或更less，因为FSO方法需要几分钟。 它仍然涉及到一个循环，所以我不知道为什么它是如此之快，但它是。

这需要一个像“c：\ windows \”的path，并返回该文件夹中所有文件（和目录）的集合。 我使用的确切参数需要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