copy a folder- and all subfolders - without overwriting existing - vba

Question

0
I am trying to create a backup database on a network drive using fso.folder copy. My intention is to move all files and subfolder within the folder, but if a file already exists on the backup drive, skip it, and copy the remainder of the files in the folder.
FSO.copyfolder Source:=Sourcefilename, Destination:=Destinfilename, OverwriteFiles:= False
However, the script errors when it finds the existing file. Any advice would be appreciated.

Answer 1

Please, try the next code:
Sub testCopyFolder()
Dim FSO As Object, SourceFold As String, DestinationFold As String
SourceFold = "Source folder path" ' ending in "\"
DestinationFold = "Destination folder path" ' ending in "\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(DestinationFold) Then
FSO.CopyFolder SourceFold, DestinationFold
End If
End Sub
You can proceed in a similar way in order to copy files. Of course, using FSO.FileExists()...

Answer 2

Backup Folder and Its Subfolders Without Overwriting
The following will backup a Source Folder to a Destination Folder i.e. copy missing folders and files.
TESTcopyFolder is just an example how you could use the solution.
It will call the initializing procedure, backupFolder, which will call backupFolderCopy and backupFolderRecurse when necessary.
The declaration Private SkipPath As String and the three procedures have to be copied to the same (usually standard) module, e.g. Module1.
The Code
Option Explicit
Private SkipPath As String
Sub TESTcopyFolder()
Const srcPath As String = "F:\Test\2020\65412587\Test1"
Const dstPath As String = "F:\Test\2020\65412587\Test2"
backupFolder srcPath, dstPath
' Open Destination Path in File Explorer.
'ThisWorkbook.FollowHyperlink dstPath
End Sub
' Initialize
Sub backupFolder( _
ByVal srcPath As String, _
ByVal dstPath As String, _
Optional ByVal backupSubFolders As Boolean = True)
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
With fso
If .FolderExists(srcPath) Then
backupFolderCopy fso, srcPath, dstPath
If backupSubFolders Then
SkipPath = ""
backupFolderRecurse fso, srcPath, dstPath
End If
MsgBox "Backup updated.", vbInformation, "Success"
Else
MsgBox "Source Folder does not exist.", vbCritical, "No Source"
End If
End With
End Sub
' Copy Folders
Private Function backupFolderCopy( _
fso As Object, _
ByVal srcPath As String, _
ByVal dstPath As String) _
As String
With fso
If .FolderExists(dstPath) Then
Dim fsoFile As Object
Dim dstFilePath As String
For Each fsoFile In .GetFolder(srcPath).Files
dstFilePath = .BuildPath(dstPath, fsoFile.Name)
' Or:
'dstFilePath = Replace(fsoFile.Path, srcPath, dstPath)
If Not .FileExists(dstFilePath) Then
.CopyFile fsoFile.Path, dstFilePath
End If
Next fsoFile
'backupFolderCopy = "" ' redundant: it is "" by default.
Else
.CopyFolder srcPath, dstPath
backupFolderCopy = srcPath
End If
End With
End Function
' Copy SubFolders
Private Sub backupFolderRecurse( _
fso As Object, _
ByVal srcPath As String, _
ByVal dstPath As String)
Dim fsoFolder As Object: Set fsoFolder = fso.GetFolder(srcPath)
Dim fsoSubFolder As Object
Dim srcNew As String
Dim dstNew As String
For Each fsoSubFolder In fsoFolder.SubFolders
srcNew = fsoSubFolder.Path
dstNew = fso.BuildPath(dstPath, fsoSubFolder.Name)
' Or:
'dstNew = Replace(srcNew, srcPath, dstPath)
If Len(SkipPath) = 0 Or Left(srcNew, Len(SkipPath)) <> SkipPath Then
SkipPath = backupFolderCopy(fso, srcNew, dstNew)
backupFolderRecurse fso, srcNew, dstNew
End If
Next
End Sub