VBA，文件系統對象，速度/優勢/劣勢

Question

這變成了一個相當長的帖子，並沒有真正的「答案」每個說。我更多地尋找解釋，而不是一些銀彈來解決問題。因此，任何你想回答的方面都會非常感激。提前致謝！

---

我遇到什麼可能是一個「問題」與文件系統對象，而這導致大約在VBA文件系統對象的工作原理與「別的東西的功能等問題「（我不知道是否有另一種方法可以在Excel中用於我在做的事情）.net等等。我不知道有更好的地方可以問，而且我也不確定要查看什麼爲自己研究它。所以我就在這裏！

所以！解決問題。簡單的解釋是我遍歷文件夾，收集文件信息（名稱，擴展名，完整路徑等）並將其放入電子表格中。我最終使用此信息將文件複製到新位置。然而，在大規模（1,000多個文件）中，這似乎在本地工作得很好，但在網絡位置（在工作中）卻相當慢。它會通過1,500個文件咀嚼，等待一會，再做1500次等。在列出或複製文件時。再說一遍，當本地完成時，情況並非如此，它只會毫無問題地運行，所以我可能會認爲它可能與我的代碼無關。這幾乎就像網絡間歇性地打開和關閉大門一樣。

或者，從最終用戶的角度使用其他程序（我嘗試了與我的程序一起使用的相同文件，在我們的工作網絡上），沒有任何上述延遲，速度會更快。如果它很重要，我假設替代程序正在使用.net的某個版本。長話短說，我不認爲我可以固有地指責我們的網絡，因爲我遇到的速度問題。

所以我的問題/好奇心/問題歸結爲幾個關鍵點：

- 什麼是該FSO在VBA和.NET中的默認庫之間的差異，可以將問題的原因之間的區別我正在跑？顯然，讀取這類數據比讀取數據要快得多。

- 是否FSO不打算以這種方式使用（通過網絡，具有大量的遠程數據，或...？）？它只是過時/過時嗎？還有一種可以通過VBA使用的替代方案嗎？

- 我只知道我們的網絡功能與本地驅動不同。它存儲了很多兆兆字節的數據等，我不確定在訪問本地驅動器和網絡位置之間有什麼不同。我知道我沒有提供可能對診斷非常有益的網絡細節，但我不幸的是沒有提供這方面的信息。我想我只是問，如果「有可能」解釋說以某種/所有種類的網絡使用FSO的方式不符合它的使用方式。是否有可能以這種方式限制我試圖與之交互的方式？

- 即使我沒有遇到過在本地執行此操作的任何問題，是否有可能我的代碼中的某些內容對網絡位置和本地驅動器造成了更多的負擔？

感謝您提供的任何見解。

Answer 1

Finch042承認他只是「模糊的」關於訪問網絡服務器的文件系統與本地文件系統時，所不同的是細節，而他的問題實際上是關於相對這兩種情況之間的速度不同。這裏的所有其他帖子都假設這個問題是與他的設計選擇和/或編碼技術有關的，但我認爲其根本問題沒有得到答案：爲什麼網絡文件操作會變得如此慢？

簡短的回答是，網絡文件系統在LAN電纜末端（或更糟糕的是Wifi信號）位於另一臺計算機的光盤上，而且這種中間技術在數據傳輸帶寬方面的限制要比計算機處理器和本地光盤之間的電子電路。確實，與石器時代相比，現代局域網的容量非常快，但它們的速度仍然遠遠低於PC主板上的光盤接口電子設備。因此，訪問遠程文件時，您總是會遇到某種程度的性能下降。此外，許多現代服務器場系統可能包括用於數據完整性維護的鏡像（即存儲冗餘），並且還可能包括自動版本備份功能，這兩種功能都可以增加某些服務器操作的訪問時間，尤其是在編寫新的文件或更新現有的文件。

至於到/來自服務器的數據傳輸速率的波動，Finch042將其描述爲數據流的明顯「門控」：無論何時使用通用訪問技術，例如LAN系統和共享服務器，你通常會與其他嘗試做類似事情的人競爭。例如，傳統以太網等LAN技術實際上允許各種用戶踩踏對方的傳輸嘗試，並在嘗試失敗時進行重試，直到成功爲止。這是一種交易簡單性的設計，因此最終的整體可靠性對於吞吐速度的（通常）輕微損失而言也是如此。但是，當網絡需求很高時，可能會導致所有用戶的吞吐量急劇下降。

同樣，文件服務器的文件系統訪問請求服務能力有限，並且在高需求時也會變得過載。

我懷疑Finch042的經驗可能與這些問題有關，特別是如果他的組織的網絡和服務器系統增量增長，並且因此以非優化方式，長時間和/或處於或接近其容量限制。他在數據傳輸速率不一致方面的經驗很可能只是普通的共享網絡/服務器系統上的需求消退和流量。

此外，請注意病毒防護系統可能會干擾文件訪問速度，尤其是對於網絡服務器文件。

Answer 2

而不是使用FSO，如果我想要更快的速度，我會使用DIR()。
但是，它不是非常安全的，因此您需要進行幾項測試，並確保它可以在任何場合使用。
例如，您可能需要檢查單個父文件夾以確保它們存在。

反正，Dir()應該更快，因爲它是本機功能。

解決此問題的另一種方法是使用批處理（如果您當然是在寡婦！）或使用命令行來簡單地從一個文件複製到另一個文件。你應該看到速度的急劇增加，你不必擔心檢查每個子文件夾的存在！

我碰巧有一個VBA代碼可以使用Windows命令行來做我想做的事情。我是從互聯網，但調整了一些錯誤的確認繞過了我想做的事：

Option Explicit 
Option Base 0 
Option Compare Text 

Private Type SECURITY_ATTRIBUTES 
    nLength As Long 
    lpSecurityDescriptor As Long 
    bInheritHandle As Long 
End Type 

Private Type PROCESS_INFORMATION 
    hProcess As Long 
    hThread As Long 
    dwProcessId As Long 
    dwThreadId As Long 
End Type 

Private Type STARTUPINFO 
    cb As Long 
    lpReserved As Long 
    lpDesktop As Long 
    lpTitle As Long 
    dwX As Long 
    dwY As Long 
    dwXSize As Long 
    dwYSize As Long 
    dwXCountChars As Long 
    dwYCountChars As Long 
    dwFillAttribute As Long 
    dwFlags As Long 
    wShowWindow As Integer 
    cbReserved2 As Integer 
    lpReserved2 As Byte 
    hStdInput As Long 
    hStdOutput As Long 
    hStdError As Long 
End Type 

Private Const WAIT_INFINITE   As Long = (-1&) 
Private Const STARTF_USESHOWWINDOW As Long = &H1 
Private Const STARTF_USESTDHANDLES As Long = &H100 
Private Const SW_HIDE    As Long = 0& 

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long 
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long 
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long 
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO) 
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long 

Public Function Redirect(szBinaryPath As String, szCommandLn As String) As String 

Dim tSA_CreatePipe    As SECURITY_ATTRIBUTES 
Dim tSA_CreateProcessPrc  As SECURITY_ATTRIBUTES 
Dim tSA_CreateProcessThrd  As SECURITY_ATTRIBUTES 
Dim tSA_CreateProcessPrcInfo As PROCESS_INFORMATION 
Dim tStartupInfo    As STARTUPINFO 
Dim hRead      As Long 
Dim hWrite      As Long 
Dim bRead      As Long 
Dim abytBuff()     As Byte 
Dim lngResult     As Long 
Dim szFullCommand    As String 
Dim lngExitCode     As Long 
Dim lngSizeOf     As Long 

tSA_CreatePipe.nLength = Len(tSA_CreatePipe) 
tSA_CreatePipe.lpSecurityDescriptor = 0& 
tSA_CreatePipe.bInheritHandle = True 

tSA_CreateProcessPrc.nLength = Len(tSA_CreateProcessPrc) 
tSA_CreateProcessThrd.nLength = Len(tSA_CreateProcessThrd) 

If (CreatePipe(hRead, hWrite, tSA_CreatePipe, 0&) <> 0&) Then 
    tStartupInfo.cb = Len(tStartupInfo) 
    GetStartupInfo tStartupInfo 

    With tStartupInfo 
     .hStdOutput = hWrite 
     .hStdError = hWrite 
     .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES 
     .wShowWindow = SW_HIDE 
    End With 

    szFullCommand = """" & szBinaryPath & """" & " " & szCommandLn 
    lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, True, 0&, 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo) 

    If (lngResult <> 0&) Then 
     lngResult = WaitForSingleObject(tSA_CreateProcessPrcInfo.hProcess, WAIT_INFINITE) 
     lngSizeOf = GetFileSize(hRead, 0&) 
     If (lngSizeOf > 0) Then 
      ReDim abytBuff(lngSizeOf - 1) 
      If ReadFile(hRead, abytBuff(0), UBound(abytBuff) + 1, bRead, ByVal 0&) Then 
       Redirect = StrConv(abytBuff, vbUnicode) 
      End If 
     End If 
     Call GetExitCodeProcess(tSA_CreateProcessPrcInfo.hProcess, lngExitCode) 
     CloseHandle tSA_CreateProcessPrcInfo.hThread 
     CloseHandle tSA_CreateProcessPrcInfo.hProcess 

     'If (lngExitCode <> 0&) Then Err.Raise vbObject + 1235&, "GetExitCodeProcess", "Non-zero Application exist code" 

     CloseHandle hWrite 
     CloseHandle hRead 
    Else 
     Err.Raise vbObject + 1236&, "CreateProcess", "CreateProcess Failed, Code: " & Err.LastDllError 
    End If 
End If 
End Function 

您將通過
resp = Redirect("cmd", strCmd)
其中cmd相當於按WINDOWS + R和strCmd使用命令行是您輸入到該運行提示的字符串。

要進一步解答有關本地驅動器和網絡驅動器之間性能差異的問題，在任何類型的代碼中使用網絡驅動器總是會比較慢。我們訪問網絡驅動器時運行的後臺代碼很複雜，但我不知道具體情況。

希望它能幫助，
乾杯，
kpark

Answer 3

（我張貼作爲一個答案，以下是太長了評論。）

我得到你可能會餵養的印象值一次一個地轉換爲Excel單元格，或者一次一行。我會用一個數組Dim arr(100, 4) As String填充它的值，然後一次填充大範圍Range("A1:E101") = arr。我會嘗試100的大小，因爲我懷疑它可能是大得多大。我優先使用FSO（VBA方法）Dir，FileCopy和Kill，只在必要時使用FSO。

VB.NET有許多其他選項，例如列表（可能是一個類的內存），StreamBuilder中的StringBuilder。但是，如果仍然需要Excel Interop，那麼這些方法的優點可能會丟失。在這種情況下，我可能會考慮寫入一個csv文件，該文件可以直接由Excel打開。 Excel Interop仍然可以使用，但我會寫入csv，然後在Excel中打開它（作爲單個語句）。從邏輯上講，我認爲在與網絡文件相同的位置創建此文本文件會更有效，然後再移動它 - 但有人可能會更正此假設。

Answer 4

對於網絡上的1500個文件，你的意思是什麼？我認爲以下使用FSO的實現不是太慢，但是你希望得到多快？

Sub TestBuildFileStructure() 
' Call to test GetFiles function. 

Const sDIRECTORYTOCHECK As String = <enter path to check from as string> 

Dim varItem   As Variant 
Dim wkbOutputFile As Workbook 
Dim shtOutputSheet As Worksheet 
Dim sDate   As String 
Dim sPath   As String 
Dim lRowNumber  As Long 
Dim vSplit   As Variant 

sPath = ThisWorkbook.Path 

sDate = CStr(Now) 
vSplit = Split(sDate, "/") 
sDate = vSplit(0) & vSplit(1) & vSplit(2) 
vSplit = Split(sDate, ":") 
sDate = vSplit(0) & vSplit(1) & vSplit(2) 

sDate = "Check " & sDate 

Set wkbOutputFile = Workbooks.Add 
'wkbOutputFile.Name = sDate 
Set shtOutputSheet = wkbOutputFile.Sheets.Add 
shtOutputSheet.Name = "Output" 

lRowNumber = 1 


Call BuildFileStructure(sDIRECTORYTOCHECK, shtOutputSheet, lRowNumber, True) 

wkbOutputFile.SaveAs (sPath & "\" & sDate) 



Cleanup: 

Set shtOutputSheet = Nothing 
Set wkbOutputFile = Nothing 

End Sub 

Function BuildFileStructure(ByVal strPath As String, _ 
       ByRef shtOutputSheet As Worksheet, _ 
       ByRef lRowNumber As Long, _ 
       Optional ByVal blnRecursive As Boolean) As Boolean 

    ' This procedure returns all the files in a directory into 
    ' an excel file. If called recursively, it also returns 
    ' all files in subfolders. 

    Const iNAMECOLUMN As Integer = 1 

    Dim fsoSysObj  As FileSystemObject 
    Dim fdrFolder  As Folder 
    Dim fdrSubFolder As Folder 
    Dim filFile   As File 

    ' Return new FileSystemObject. 
    Set fsoSysObj = New FileSystemObject 

    On Error Resume Next 
    ' Get folder. 
    Set fdrFolder = fsoSysObj.GetFolder(strPath) 

    If Err <> 0 Then 
     ' Incorrect path. 
     BuildFileStructure = False 
     GoTo BuildFileStructure_End 
    End If 
    On Error GoTo 0 

    ' Loop through Files collection, adding to dictionary. 
    For Each filFile In fdrFolder.Files 
     shtOutputSheet.Cells(lRowNumber, iNAMECOLUMN).Value = filFile.Path 
     lRowNumber = lRowNumber + 1 
    Next filFile 

    ' If Recursive flag is true, call recursively. 
    If blnRecursive Then 
     For Each fdrSubFolder In fdrFolder.SubFolders 
      Call BuildFileStructure(fdrSubFolder.Path, shtOutputSheet, lRowNumber, True) 
     Next fdrSubFolder 
    End If 

    ' Return True if no error occurred. 
    BuildFileStructure = True 

BuildFileStructure_End: 
    Set fdrSubFolder = Nothing 
    Set fdrFolder = Nothing 
    Set filFile = Nothing 
    Set fsoSysObj = Nothing 

    Exit Function 
End Function