Filesystemobject permission denied - ways to check / skip?

Question

I have a tool that copies all files from one folder into 10 seperate folders (all stored on different servers).

Sometimes when running this tool, I will get a permission denied error - which I presume comes down to a user being in one of the files that the program tries to overwrite.

Is there a way to confirm where the error occurs, and on top of that.. is there any way to create a report which shows which files were unsuccessful, but continue running after hitting the error?

Hope this makes sense, it is a generic FSO loop (think it was ron de bruin example)

Can you help? Error handling is definitely not my VBA forte!

I have the variables set before this with the filepaths and a seperate macro for each folder that gets copied - here is the code below

Handling the error is more important for me right now as it would let me pinpoint the issue

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

Let's see if this helps out at all. The idea is to use your FSO to open the destination folder, and attempt to delete each file & subdirectory in the folder. This relies on the helper functions DeleteFile and DeleteFolder.

Module declarations: Important!

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

This is the main procedure, note that you MUST declare all of your variables because of the Option Explicit at the module level.

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

Helper functions:

The DeleteFolder procedure calls on DeleteFile for each file at its top level, and then calls itself recursively for each subdirectory in the specified folder path, if any.

The DeleteFile procedure logs each error to the errors collection, which we then use to write to a text file on your Desktop.

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

Observations

The error log may contain some duplicates, or near-duplicates, as a lock file may be created, e.g. below. These are usually denoted with a tilde character, but since that is legal in a file name, I do not make any attempt to isolate or ignore "duplicates":

• c:\my files\excel_file1.xlsx
• c:\my files\~excel_file1.xlsx

Certain file types may not raise an error that can be trapped in the above code (.txt for example I think will not error if open in Notepad, etc.). In these cases, the above procedures I think will successfully delete the file, but now you have the risk that the user may save the old version over your newly copied version. I don't know how to prevent this from happening; your problem really is an architecture and replication one, and that is not well-suited to be handled by VBA from Excel...