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

Question

这变成了一个相当长的帖子，并且每个说法都没有真正的“答案”。我更倾向于寻找解释，而不是解决问题。因此，您要回答的任何方面都会非常感激。提前致谢！

---

我正在遇到文件系统对象可能存在的“问题”，这导致了一个关于VBA中的文件系统对象如何工作的功能等问题与“别的”有关的问题（我不知道）我不知道有更好的地方可以问，我不知道有什么好的地方可以自己研究一下。所以我来了！

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

或者，从最终用户角度使用其他程序（我在我的工作网络上使用与我的程序相同的文件进行了尝试），没有任何上述延迟，它会更快。我假设替代程序正在使用某些版本的.net，如果重要的话。长话短说，我不认为我本来可以责怪我们的网络因为我遇到的速度问题。

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

- VBA中的FSO和.Net中的默认库之间的区别是什么？我遇到的问题原因之间的区别是什么？显然，可以比完成这些数据更快地读取此类数据。

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

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

- 即使我在本地没有遇到任何问题，我的代码中的某些内容是否可能对网络位置和本地驱动器更加负担？

感谢您提供的任何见解。

Answer 1

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

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

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

关于进出服务器的数据传输速率的波动，Finch042将其描述为数据流的明显“门控”：无论何时使用通用访问技术，例如LAN系统和共享服务器，你经常与试图做类似事情的其他人竞争。例如，传统以太网等局域网技术实际上允许各种用户踩踏彼此的传输尝试，当这确实导致尝试失败时，它会重新开始直到成功。这种设计可以简化交易，从而实现最终的整体可靠性，从而实现吞吐速度的（通常）轻微损失。但是当网络需求很高时，它可能导致所有用户的吞吐量急剧下降。

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

我怀疑Finch042的经验很可能与这些问题有关，特别是如果他的组织的网络和服务器系统逐渐增长，因此以非优化的方式，长时间，和/或处于或接近其容量限制。他对数据传输率不一致的经验可能只是普通共享网络/服务器系统的需求起伏不定。

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

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 Interop，则可能会丢失这些方法的优点。在这种情况下，我可能会考虑写入一个csv文件，该文件可以直接由Excel打开。仍然可以使用Excel Interop，但我会写入csv然后在Excel中打开它（作为单个语句）。

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

Answer 3

如果我想要更快的速度，我会使用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是您在该运行提示中输入的字符串。

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

希望它有所帮助，
干杯，
kpark

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