Excel VBA高效获取文件名功能 [英] Excel VBA efficient get file names function

问题描述

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

I need to get a collection of file names from a folder on a remote server using VBA in excel 2010. I have a function that works and in the majority of cases it would do the job, however the remote server frequently has terrible, terrible network performance issues. This means that looping through say 300 files to put their names into a collection can take 10 minutes, the number of files in the folder is likely to grow to thousands so this is not workable, I need a way to get all of the file names in a single network request and not looping. I believe its connecting to the remote server that is taking the time so a single request should be able to get all of the files in one pass fairly quickly.

这是我目前拥有的功能:

This is the function I currently have in place:

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

推荐答案

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

Ok, I have found a solution that works for my situation and perhaps others will find it useful too. This soution uses the windows API and gets me the filenames in 1 second or less where as the FSO method was taking several minutes. It still involves a loop so i'm not certain why it is so much faster but it is.

这采用类似"c:\ windows \"的路径，并返回该文件夹中所有文件(和目录)的集合.我使用的确切参数需要Windows 7或更高版本，请参见声明中的注释.

This takes a path like "c:\windows\" and returns a collection of all the files (and directories) in that folder. The exact parameters I have used require windows 7 or newer, see the comments in the declarations.

'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高效获取文件名功能的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！