FileSystemObject 代码已开始抛出错误

Question

不知道为什么，但是下面的代码已经开始抛出一个未知错误。当宏运行时 Excel 停止响应。

• 为什么会出现这个错误？
• 具有相同功能的替代路由是什么？

此代码位于 Windows 7 机器上的 Excel 2010 xlsm 文件中。

 Sub CopyFolderToCasinoDirectory()

        'reference Microsoft Scripting Runtime
        On Error Resume Next

        Dim fso As Scripting.FileSystemObject
        Set fso = New Scripting.FileSystemObject
        fso.CopyFolder _
              "\\xxxfileserve\department$\DBA\Opers\All Operators\yyy", _
              "\\xxxfileserve\department$\DBA\Cas\yyy", _
              True

        On Error GoTo 0
        Set fso = Nothing

    End Sub

好的 - 我已经更改了路径，以便它尝试移动更少的文件 - 它犹豫不决，但最终还是通过了。我怀疑上述失败是因为指定目录中的文件太多？目前有 753 个文件 - 可能太多了？

RonDeBruin 给了我很多关于如何测试或改变逻辑的想法。一种可能是先在目标文件夹上使用 DeleteFolder，然后在目标文件夹上使用 CopyFolder？

Answer 1

抱歉这么晚才回复。我无法获取网络目录，我想在发布代码之前对其进行测试:)

试试这个。运行Sub Sample() 它仍然挂起吗？您还将在 Windows 对话框中看到正在传输的文件。

Private Declare Function SHFileOperation _
Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long

Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAborted As Boolean
    hNameMaps As Long
    sProgress As String
End Type

Private Const FO_COPY = &H2

Sub Sample()
    Dim path1 As String, path2 As String

    path1 = "\\xxxfileserve\department$\DBA\Opers\All Operators\yyy"
    path2 = "\\xxxfileserve\department$\DBA\Opers\All Operators\yyy"

    If CopyFolder(path1, path2) Then
        MsgBox "Copied"
    Else
        MsgBox "Not copied"
    End If
End Sub

Private Function CopyFolder(ByVal sFrom As String, _
ByVal sTo As String) As Boolean
    Dim SHFileOp As SHFILEOPSTRUCT
    On Error GoTo Whoa
    CopyFolder = False
    With SHFileOp
        .wFunc = FO_COPY
        .pFrom = sFrom
        .pTo = sTo
    End With
    SHFileOperation SHFileOp
    CopyFolder = True
    Exit Function
Whoa:
    MsgBox "Following error occurred while copying folder " & sFrom & vbCrLf & _
    Err.Description, vbExclamation, "Error message"
End Function

Answer 2

关于fso.CopyFolder方法有几点：

• 如果目标不存在，则复制源文件夹及其所有内容。这是通常的情况。
• 如果目标是现有文件，则会发生错误。
• 如果目标是一个目录，则会尝试复制该文件夹及其所有内容。
• 如果源中包含的文件已存在于目标中，则如果覆盖为 False，则会发生错误。否则，它将尝试将文件复制到现有文件上。
• 如果目标是只读目录，如果尝试将现有只读文件复制到该目录并且覆盖为 False，则会发生错误。

确保这些都不会成为您的sub 的障碍。

但是用另一种方式测试它

fso.CopyFolder _
              "\\xxxfileserve\department$\DBA\Opers\All Operators\yyy\*", _
              "\\xxxfileserve\department$\DBA\Cas\yyy", _
              True

---

希望这会有所帮助。