Question

我有一个工具可以将一个文件夹中的所有文件复制到10个单独的文件夹中（所有文件都存储在不同的服务器上）。

有时在运行此工具时，我会收到一个权限被拒绝的错误 - 我认为该错误归结为用户正在程序试图覆盖的其中一个文件中。

有没有办法确认错误发生的位置，最重要的是..有没有办法创建一个报告，显示哪些文件不成功，但在遇到错误后继续运行？

希望这是有道理的，它是一个通用的FSO循环（认为它是ron de bruin的例子）

你能帮忙吗？错误处理绝对不是我的VBA强项！

我之前设置的变量包含文件路径和每个被复制文件夹的单独宏 - 这是下面的代码

现在处理错误对我来说更重要，因为它可以让我找出问题

If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    If Right(ToPath2, 1) = "\" Then
        ToPath = Left(ToPath2, Len(ToPath) - 1)
    End If

        If Right(ToPath3, 1) = "\" Then
        ToPath = Left(ToPath3, Len(ToPath) - 1)
    End If

        If Right(ToPath4, 1) = "\" Then
        ToPath = Left(ToPath4, Len(ToPath) - 1)
    End If

        If Right(ToPath5, 1) = "\" Then
        ToPath = Left(ToPath5, Len(ToPath) - 1)
    End If

        If Right(ToPath6, 1) = "\" Then
        ToPath = Left(ToPath6, Len(ToPath) - 1)
    End If

        If Right(ToPath7, 1) = "\" Then
        ToPath = Left(ToPath7, Len(ToPath) - 1)
    End If

        If Right(ToPath8, 1) = "\" Then
        ToPath = Left(ToPath8, Len(ToPath) - 1)
    End If

        If Right(ToPath9, 1) = "\" Then
        ToPath = Left(ToPath9, Len(ToPath) - 1)
    End If

        If Right(ToPath10, 1) = "\" Then
        ToPath = Left(ToPath10, Len(ToPath) - 1)
    End If




    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath2
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath3
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath4
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath5
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath6
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath7
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath8
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath9
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath10

Answer 1

让我们看看这是否有帮助。我们的想法是使用您的FSO打开目标文件夹，并尝试删除每个文件＆amp;文件夹中的子目录。这依赖于辅助函数DeleteFile和DeleteFolder。

模块声明：重要！

Option Explicit
Dim errors As Collection
Dim file As Object 'Scripting.File
Dim fldr As Object 'Scripting.Folder

这是主要程序，请注意，由于模块级别的Option Explicit，您必须声明所有变量。

Sub CopyFolderWithErrorHandling()
Dim FSO As Object 'Scripting.FileSystemObject
Dim paths As Variant
Dim path As Variant
Dim FromPath As String
Dim i As Long
Dim ToPath1$, ToPath2$, ToPath3$, ToPath4$, ToPath5$, ToPath6$, ToPath7$, ToPath8$, ToPath9$, ToPath10$

'!!!### IMPORTANT ###!!!
'    Assign all of your "ToPath" variables here:
ToPath1 = "c:\some\path"
'Etc.

Set FSO = CreateObject("scripting.filesystemobject")
Set errors = New Collection

FromPath = "C:\Debug\" '## Modify as needed

If FSO.FolderExists(FromPath) = False Then
    MsgBox FromPath & " doesn't exist"
    Exit Sub
End If

'## Create an array of destination paths for concise coding
paths = Array(ToPath1, ToPath2, ToPath3, ToPath4, ToPath5, ToPath6, ToPath7, ToPath8, ToPath9, ToPath10)

'## Ensure each path is well-formed:
For i = 0 To UBound(paths)
    path = paths(i)
    If Right(path, 1) = "\" Then
        path = Left(path, Len(path) - 1)
    End If
    paths(i) = path
Next

'## Attempt to delete the destination paths and identify any file locks
For Each path In paths
    '# This funcitno will attempt to delete each file & subdirectory in the folder path
    Call DeleteFolder(FSO, path)
Next


'## If there are no errors, then do the copy:
If errors.Count = 0 Then
    For Each path In paths
        FSO.CopyFolder FromPath, path
    Next
Else:
    '# inform you of errors, you should modify to print a text file...
    Dim str$

    For Each e In errors
        str = str & e & vbNewLine
    Next

    '## Create an error log on your desktop
    FSO.CreateTextFile(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\errors.txt").Write str

End If

Set errors = Nothing
End Sub

帮助程序功能：

DeleteFolder过程在其顶层的每个文件上调用DeleteFile，然后以递归方式为指定文件夹路径中的每个子目录调用自身。如果有的话。

DeleteFile过程会将每个错误记录到errors集合，然后我们将其用于写入桌面上的文本文件。

Sub DeleteFolder(FSO As Object, path As Variant)

'Check each file in the folder
For Each file In FSO.GetFolder(path).Files
    Call DeleteFile(FSO, file)
Next
'Check each subdirectory
For Each fldr In FSO.GetFolder(path).SubFolders
    Call DeleteFolder(FSO, fldr.path)
Next

End Sub
Sub DeleteFile(FSO As Object, file)
    On Error Resume Next
    Kill file.path
    If Err.Number <> 0 Then
        errors.Add file.path
    End If
End Sub

<强>观察

错误日志可能包含一些重复项或近似重复项，因为可能会创建一个锁定文件，例如：下面。这些通常用波浪号字符表示，但由于这在文件名中是合法的，我不会尝试隔离或忽略＆＃34;重复＆＃34;：

c：\ my files \ excel_file1.xlsx
c：\ my files \ ~excel_file1.xlsx

某些文件类型可能不会引发可以在上面的代码中捕获的错误（.txt，例如我认为如果在记事本中打开则不会出错，等等）。在这些情况下，上述程序我认为将成功删除该文件，但现在您可能会面临用户可能将旧版本保存在新复制版本上的风险。我不知道如何防止这种情况发生;你的问题确实是一个架构和复制问题，而且不适合由VBA从Excel处理......

Filesystemobject权限被拒绝 - 检查/跳过的方法？

1 个答案: