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 

Answer 1

좋아, 내 상황에 작동하고 아마 다른 사람들도 유용하게 찾을 수있는 솔루션을 발견했다. 이 soution은 Windows API를 사용하고 FSO 메소드가 몇 분이 걸리는 것처럼 1 초 이내에 파일 이름을 가져옵니다. 그것은 여전히 ​​루프가 포함되어 있으므로 왜 그렇게 빠르지는 확실하지 않지만 그렇습니다.

"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 프롬프트, 전체 파일 구조에서 아래 명령을 입력 할 때

을하는 텍스트 파일

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 

에서 모든 Y 그래서 지금

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 

을 (이 MYFILE.TXT에 저장되는 것입니다) 원격 폴더의 텍스트 파일을 폴더에 복사하고 파일 이름을 얻기 위해 구문 분석 만하면됩니다. 이 함수를 호출

Sub filesTest() 
    Dim x() As String 
    x = Function_FileList("YOUR_PATH_AND_FOLDER_NAME") 
    Debug.Print Join(x, vbCrLf) 
    End Sub 

:

Answer 3

이 사람은 빠른 번개입니다

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