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

我认为会有一个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

所以现在你需要做的就是将文本文件从远程文件夹复制到你的文件夹，只需解析它就可以得到文件名。

Answer 3

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

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

Excel VBA高效获取文件名功能

3 个答案: