Excel VBA эффективная функция имени файла

Question

Мне нужно получить коллекцию имен файлов из папки на удаленном сервере с использованием VBA в excel 2010. У меня есть функция, которая работает, и в большинстве случаев она будет выполнять эту работу, однако на удаленном сервере часто бывает ужасно, ужасно проблемы с производительностью сети. Это означает, что зацикливание через 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

Хорошо, я нашел решение, которое работает для моей ситуации и, возможно, другие считают это полезным тоже. Этот soution использует API окон и получает имена файлов за 1 секунду или меньше, когда метод FSO занимал несколько минут. Он по-прежнему связан с циклом, поэтому я не уверен, почему он намного быстрее, но это так.

Это берет путь как «c: \ 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 

Answer 2

Я подумал, что было бы API, которые могли бы заставить меня имена файлов в директории без зацикливания, но не смог его найти. Весь код, который я знаю, включает в себя цикл с использованием fso или dir.

Так можно получить имена файлов без циклов. Я думаю, да ... Вот один способ, которым я могу думать ...

При вводе следующей команды в DOS Prompt, вся структура файла передается в текстовый файл

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 

Так что теперь все у ou нужно сделать, это скопировать текстовый файл из удаленной папки в вашу папку и просто проанализировать его, чтобы получить имена файлов.

Answer 3

Это один молниеносно:

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