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

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

---

我遇到了文件系统对象可能存在的“问题”，这导致了一个关于VBA中的文件系统对象如何工作的功能等问题，与.net中的“其他东西”（我不知道是否有其他方法可以在Excel中使用）等问题。我不知道还有什么更好的地方可以问，我也不知道自己要研究什么。我来了

所以！解决这个问题。简单的解释是，我遍历文件夹，收集文件信息（名称、扩展名、完整路径等），然后将其放入电子表格中。我最终使用这些信息将文件复制到一个新位置。然而，在大规模（1000多个文件）上，这似乎在本地运行得很好，但在网络位置（工作时）运行得相当慢。在列出或复制文件时，它将仔细阅读1500个文件，等待一段时间，再执行1500个等等。同样，当在本地完成时，情况并非如此，它只会毫无问题地运行，因此我可以假设这可能与我的代码无关。这几乎就像网络在断断续续地打开和关闭一扇门

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

因此，我的问题/好奇心/问题归结为几个关键点：

-VBA中的FSO和.Net中的默认库有什么区别？我遇到的问题的原因有什么区别？很明显，读取此类数据的速度可能比现在快得多

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

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

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

---

感谢您提供的任何见解

如果我想要更快的速度，我会使用

DIR（）

而不是FSO。
但是，它并不是故障安全的，因此您需要进行两次测试，并确保它在所有情况下都能正常工作。
例如，您可能需要检查单个父文件夹以确保它们存在。

无论如何，

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

选项显式
选项库0
选项比较文本
私有类型安全属性
长度等于
lpSecurityDescriptor的长度
长柄
端型
私有类型进程信息
hProcess尽可能长
hThread尽可能长
dwProcessId尽可能长
dwThreadId尽可能长
端型
私有类型STARTUPINFO
只要
保留的时间尽可能长
lpDesktop尽可能长
尽可能长的标题
dwX尽可能长
只要
dwXSize尽可能长
尽可能长
dwXCountChars的长度为
德怀康查斯一样长
dwFillAttribute尽可能长
把旗子拖得一样长
wShowWindow作为整数
cbReserved2为整数
lpReserved2作为字节
HST输入长度为
hst输出长度
hStdError尽可能长
端型
Private Const WAIT_无限长=（-1&）
Private Const STARTF_USESHOWWINDOW作为Long=&H1
私人Const STARTF_USESTDHANDLES的长度=&H100
私有常量SW_隐藏长度=0&
私有声明函数CreatePipe Lib“kernel32”（phReadPipe为Long，phWritePipe为Long，lpPipeAttributes为SECURITY_属性，ByVal nSize为Long）为Long
私有声明函数CreateProcess Lib“kernel32”别名“CreateProcessA”（ByVal lpApplicationName为长，ByVal lpCommandLine为字符串，lpProcessAttributes为任意，lpThreadAttributes为任意，ByVal bInheritHandles为长，ByVal dwCreationFlags为长，lpEnvironment为任意，ByVal lpCurrentDriectory为字符串，lpStartupInfo为STARTUPINFO，lpProcessInformation为进程信息）为长
私有声明函数ReadFile Lib“kernel32”（ByVal hFile为长，lpBuffer为任意，ByVal nNumberOfBytesToRead为长，lpNumberOfBytesRead为长，lpOverlapped为任意）为长
私有声明函数CloseHandle Lib“kernel32”（ByVal hObject As Long）为Long
私有声明函数WaitForSingleObject库“kernel32”（ByVal
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