Hi,
I am having a hard time with my vba code. I’m trying to move some specific PDF Files that are in subfolders to a new folder but the code it’s copying every PDF files from those subfolders. Here is the code:
I am having a hard time with my vba code. I’m trying to move some specific PDF Files that are in subfolders to a new folder but the code it’s copying every PDF files from those subfolders. Here is the code:
VBA Code:
Sub CopyFiles_DEBUG()
Dim sPathSource As String, sPathDest As String, sFileSpec As String
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
Dim fso As Object, folder1 As Object
On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "command", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
sPathSource = "path to all folders and subfolders"
sPathDest = "where the specific invoices should be copied"
sFileSpec = "*.pdf"
Call CopyFiles_FromFolderAndSubFolders_DEBUG(sFileSpec, sPathSource, sPathDest)
End Sub
Sub CopyFiles_FromFolderAndSubFolders_DEBUG(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)
Debug.Print "PROCESSING >> " & oRoot.Path
For Each oFile In oRoot.Files
If LCase(oFile.Name) Like argFileSpec Then
On Error Resume Next
oFile.Copy sPathDest & oFile.Name
If Err.Number = 0 Then
Debug.Print "COPIED : " & oFile.Name
Else
Debug.Print "error : " & oFile.Name
End If
On Error GoTo 0
Else
Debug.Print "skipped: " & oFile.Name
End If
Next oFile
For Each oFolder In oRoot.SubFolders
Call CopyFiles_FromFolderAndSubFolders_DEBUG(argFileSpec, oFolder.Path, sPathDest)
Next oFolder
End If
End Sub
