VBA，文件系统对象，速度/优点/缺点

Question

这变成了一篇相当长的帖子，而且每个人都没有真正的“答案”。我更多的是寻找一个解释，而不是一些解决问题的灵丹妙药。因此，您想回答的任何方面都将不胜感激。提前致谢！

---

我遇到了文件系统对象可能存在的“问题”，这导致了一个关于 VBA 中文件系统对象如何工作与“其他东西”的功能等问题（我不知道'不知道在 .net 等中是否有替代方案可以在 Excel 中使用.所以我在这里！

所以！到问题。简短的解释是我遍历文件夹，收集文件信息（名称、扩展名、完整路径等）并将其放入电子表格中。我最终使用此信息将文件复制到新位置。但是，在大规模（超过 1,000 个文件）上，这似乎在本地工作得很好，但在网络位置（在工作中）却要慢得多。它会咀嚼 1,500 个文件，稍等片刻，再做 1,500 个等。在列出或复制文件时。同样，在本地完成时不是这种情况，它会毫无问题地运行，所以我可以假设它可能与我的代码无关。就好像网络在间歇性地打开和关闭一扇门。

或者，从最终用户的角度使用其他程序（我在我们的工作网络上针对我在程序中使用的相同文件进行了尝试）速度要快得多，而没有任何上述延迟。我假设替代程序正在使用某些版本的.net，如果重要的话。长话短说，我认为我不能天生就将遇到的速度问题归咎于我们的网络。

所以我的问题/好奇心/问题归结为几个关键点：

-VBA 中的 FSO 和 .Net 中的默认库之间有什么区别，我遇到的问题的原因可能有区别吗？很明显，读取这类数据的速度可能比完成时快得多。

-FSO 是否不打算以这种方式使用（通过网络，具有大量远程数据，或者...？）？它只是过时/过时了吗？是否有可以通过 VBA 使用的替代方法？

-我只是模糊地理解我们的网络以不同于本地驱动器的方式运行。它存储了许多 TB 的数据等，我不确定访问本地驱动器和网络位置之间在非常深层次上的区别是什么。我知道我没有在网络上提供可能对诊断非常有益的细节，不幸的是我没有提供这些信息。我想我只是问它是否“可能”解释说以这种方式与某些/所有类型的网络一起使用 FSO 并不是它应该使用的方式。网络的设置方式是否有可能限制我尝试与之交互的方式？

-即使我在本地执行此操作没有遇到任何问题，但我的代码中的某些内容是否可能对网络位置比本地驱动器更费力？

感谢您提供的任何见解。

Answer 1

如果我想要更快的速度，我会使用DIR()，而不是使用 FSO。
但是，它并不是那么万无一失，因此您需要进行几次测试并确保它在所有情况下都能正常工作。
例如，您可能需要检查各个父文件夹以确保它们存在。

无论如何，Dir() 应该更快，因为它是一个原生函数。

解决此问题的另一种方法是使用 Batch（当然，如果您在 Widows 上！）或使用命令行简单地从一个文件复制到另一个文件。您应该会看到速度显着提高，而且您不必担心检查每个子文件夹是否存在！

我碰巧有一个 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 是您输入到该运行提示符的字符串。

为了进一步回答您关于本地驱动器和网络驱动器之间性能差异的问题，在任何类型的代码中使用网络驱动器总是会变慢。我们访问网络驱动器时运行的后台代码很复杂，但我不知道具体情况。

希望对你有帮助，
干杯，
公园

Answer 2

（我将发布作为答案，因为以下内容太长，无法发表评论。）

我觉得您可能一次将一个值输入 Excel 单元格，或者一次输入一行。我会使用一个数组Dim arr(100, 4) As String 用值填充它，然后一次性填充一个大范围Range("A1:E101") = arr。我会尝试 100 的大小，因为我怀疑它可能会更多更大。与 FSO 相比，我会使用（VBA 方法）Dir、FileCopy 和 Kill，仅在必要时使用 FSO。

VB.NET 有许多其他选项，例如（可能属于某个类的）内存 Stream、StringBuilder 列表。但是，如果仍然需要 Excel 互操作，那么这些方法的优势可能会丧失。在这种情况下，我可能会考虑写入一个 csv 文件，该文件可以由 Excel 直接打开。 Excel 互操作仍然可以使用，但我会写入 csv，然后在 Excel 中打开它（作为单个语句）。

从逻辑上讲，我认为在与网络文件相同的位置创建此文本文件，然后再移动它会更有效 - 但有人可能会纠正这个假设。

Answer 3

你所说的快速是什么意思，对于网络上的 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

Answer 4

Finch042 承认他只是“模糊”地了解访问网络服务器的文件系统与访问本地文件系统时的不同之处，他的问题实际上是关于 相对 em> 这两种情况的速度不同。这里的所有其他帖子都假设问题出在他的设计选择和/或编码技术上，但我认为根本问题没有得到解答：为什么网络文件操作会这么慢？

简短的回答是，网络文件系统位于 LAN 电缆末端的另一台计算机的磁盘上（或者，更糟糕的是，Wifi 信号），并且这种中间技术的数据传输带宽比计算机处理器与其本地磁盘之间的电子设备。确实，相对于石器时代，现代 LAN 容量快得令人眼花缭乱，但它们仍然比 PC 主板上的磁盘接口电子设备慢得多。因此，您在访问远程文件时总会遇到某种程度的性能下降。

此外，许多现代服务器场系统可能包括用于数据完整性维护的镜像（即存储冗余），还可能包括自动版本备份功能，这两者都可以增加某些服务器操作的访问时间，尤其是在写入新文件时或更新现有的。

至于与服务器之间的数据传输速率的波动，Finch042 将其描述为数据流的明显“门控”：每当您使用公共访问技术（例如 LAN 系统和共享服务器）时，您通常会与尝试做类似事情的其他人竞争。例如，传统以太网之类的 LAN 技术实际上允许各种用户相互阻止对方的传输尝试，当这确实导致尝试失败时，它会重试直到成功。这是一种以简单性为代价的设计，从而以最终的整体可靠性换取（通常）吞吐速度的轻微损失。但是，当对网络的需求很高时，可能会导致所有用户的吞吐量急剧下降。

同样，文件服务器在服务文件系统访问请求方面的能力有限，而且在需求量很大的时候它也可能会过载。

我怀疑 Finch042 的经历可能与这类问题有关，特别是如果他的组织的网络和服务器系统在很长一段时间内以非优化方式逐步增长，和/或处于或接近其容量限制。而他对数据传输率不一致的经历很可能只是对通用共享网络/服务器系统的需求潮起潮落。

另外，请注意病毒防护系统会干扰文件访问速度，尤其是网络服务器文件。