VBA for copying files from folders to another folder but exclude folders with specific name

[Mimsolz]

Hi!

I have been using a VBA code for copying .pdf files from a folders (please see code below). I want it to skip folders with "working" or "~superseded" on the folder names. I've read about the InStr function but I can't figure out where to place it in this code.

Thank you so much for your help in advance!

VBA Code:

Public Sub CopyFiles_r2()

Dim sPathSource As String, sPathDest As String, sFileSpec As String

sPathSource = InputBox("Enter path")
sPathDest = "Z:\DestinationFolderTree\SubFolder\EndpointFolder\"

sFileSpec = "*.pdf"
'sFileSpec = "*example*2020.xl*"
'sFileSpec = "*.pdf"

Call CopyFiles_FromFolderAndSubFolders(sFileSpec, sPathSource, sPathDest)
End Sub


Public Sub CopyFiles_FromFolderAndSubFolders(ByVal argFileSpec As String, ByVal argSourcePath As String, ByRef argDestinationPath As String)

Dim sPathSource As String, sPathDest As String, sFileSpec As String

Dim FSO As Object
Dim oRoot As Object
Dim oFile As Object
Dim oFolder As Object

sPathSource = argSourcePath
sPathDest = argDestinationPath

If Not Right(sPathDest, 1) = "\" Then sPathDest = sPathDest & "\"
If Right(sPathSource, 1) = "\" Then sPathSource = Left(sPathSource, Len(sPathSource) - 1)

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(sPathSource) And FSO.FolderExists(sPathDest) Then
Set oRoot = FSO.GetFolder(sPathSource)
For Each oFile In oRoot.Files
If LCase(oFile.Name) Like argFileSpec Then
On Error Resume Next
oFile.Copy sPathDest & oFile.Name
On Error GoTo 0
End If
Next oFile
For Each oFolder In oRoot.SubFolders
' == do the same for any folder ==
Call CopyFiles_FromFolderAndSubFolders(argFileSpec, oFolder.Path, sPathDest)
Next oFolder
End If
End Sub

 

[John_w]

Insert before the Set FSO line:

If InStr(1, sPathSource, "working", vbTextCompare) = 0 And InStr(1, sPathSource, "~superseded", vbTextCompare) = 0 Then

and insert before the End Sub line:

End If

Please use CODE tags when posting VBA code - click the VBA icon in the message editor toolbar.

 

[Mimsolz]

Insert before the Set FSO line:

If InStr(1, sPathSource, "working", vbTextCompare) = 0 And InStr(1, sPathSource, "~superseded", vbTextCompare) = 0 Then

and insert before the End Sub line:

End If

Please use CODE tags when posting VBA code - click the VBA icon in the message editor toolbar.

Thank you so much, John! This is such a huge help.

I've edited the tags. Hopefully that's better.