2014-10-08 50 views
8

Tôi cần lấy bộ sưu tập tên tệp từ một thư mục trên máy chủ từ xa bằng VBA trong excel 2010. Tôi có một hàm hoạt động và trong phần lớn các trường hợp nó sẽ thực hiện công việc, tuy nhiên máy chủ từ xa thường gặp sự cố nghiêm trọng, khủng khiếp hiệu suất mạng. Điều này có nghĩa là việc lặp lại 300 tệp để đưa tên của họ vào bộ sưu tập có thể mất 10 phút, số lượng tệp trong thư mục có khả năng tăng lên hàng nghìn, vì vậy điều này không khả thi, tôi cần một cách để có được tất cả tên tệp trong một yêu cầu mạng đơn và không lặp lại. Tôi tin rằng kết nối của nó với máy chủ từ xa đang dành thời gian để một yêu cầu duy nhất có thể nhận được tất cả các tệp trong một lần truyền khá nhanh chóng.Excel VBA có chức năng lấy tên tệp là

Đây là chức năng Tôi hiện có tại chỗ:

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 
+0

+ 1 Câu hỏi hay :) Bạn gần như đã suy nghĩ! –

Trả lời

0

Ok, tôi đã tìm thấy một giải pháp mà làm việc cho hoàn cảnh của tôi và có lẽ người khác sẽ tìm thấy nó hữu ích quá. Điều này soution sử dụng API cửa sổ và được cho tôi tên tập tin trong 1 giây hoặc ít hơn, nơi như các phương pháp FSO đã được vài phút. Nó vẫn liên quan đến một vòng lặp vì vậy tôi không chắc chắn lý do tại sao nó là nhanh hơn rất nhiều nhưng nó được.

Điều này có đường dẫn như "c: \ windows \" và trả về một tập hợp tất cả các tệp (và thư mục) trong thư mục đó. Các tham số chính xác mà tôi đã sử dụng yêu cầu windows 7 hoặc mới hơn, xem các chú thích trong các khai báo.

'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 
0

tôi nghĩ rằng sẽ có một API mà có thể làm cho tôi tên tập tin trong một thư mục mà không cần vòng lặp nhưng không thể tìm thấy nó. Tất cả mã mà tôi biết liên quan đến việc lặp lại hoặc sử dụng fso hoặc dir.

Vì vậy, có thể lấy tên tệp mà không lặp. Tôi đoán có ... Dưới đây là một cách mà tôi có thể nghĩ đến ...

Khi bạn gõ lệnh dưới đây trong DOS Prompt, toàn bộ cấu trúc tập tin sẽ được gửi đến một tập tin văn bản

Dir C:\Temp\*.* > C:\Temp\MyFile.Txt 

Làm trên từ 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 

Ví dụ (Đây là những gì được lưu trữ trong 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 

Vì vậy, bây giờ tất cả y Bạn cần phải sao chép tệp văn bản từ thư mục từ xa vào thư mục của mình và chỉ cần phân tích cú pháp tệp đó để lấy tên tệp.

+0

Điều này vẫn chạy lệnh 'dir' từ máy cục bộ và yêu cầu danh sách tệp trên mạng. Chạy nó thông qua 'cmd.exe' vẫn thực hiện nó cục bộ. Bạn sẽ phải sao chép một tập tin batch hoặc script trên mạng, thực thi nó từ xa bằng cách sử dụng 'rexec' hoặc một cái gì đó tương tự, và sau đó chuyển tập tin kết quả trên mạng khi quá trình từ xa kết thúc (nghĩa là bạn phải đợi và bình chọn để hoàn thành). –

+0

Đúng nhưng tôi đoán đây là lựa chọn duy nhất OP có trong thời gian này? –

+0

Nó sẽ không được cải thiện.:-) Chi phí khởi chạy tệp thông qua 'rexec', bỏ phiếu, và sau đó chuyển tệp văn bản (và sau đó phân tích cú pháp tệp văn bản để lấy danh sách tệp) sẽ có tác động hiệu suất. –

8

Cái này là nhanh như chớp:

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

nào gọi chức năng này:

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 
+2

+ 1 Đơn giản chỉ cần đẹp! –

+0

Không nhanh hơn nếu bạn có kết nối mạng chậm hoặc nhiều tệp. 'dir' lặp đi lặp lại nội bộ, và chạy nó thông qua' exec' có nghĩa là nó chạy trên máy cục bộ của bạn và bị trễ cùng một mạng. –

+0

@KenWhite Điều gì nếu mã trên được đặt trong một tập tin thực thi và tập tin sau đó được sao chép vào thư mục từ xa và sau đó chạy từ đó? –

Các vấn đề liên quan