vba code-copy files from folder and sub folders

[burchette]

hi everyone,

I now its a mainstream thing that I am writing now in fso systems but I am trying to learn "how I would do that" thing, can you please help with the below code?

It does not give any error message or something but it is not copying any materials to destination.

Sub copy_specificextension_files_in_folder()
Dim FSO As Object
Dim sourcePath As String
Dim destinationPath As String
Dim fileExtn As String

sourcePath = "\\::"
destinationPath = "C:\"
fileExtn = "*.pdf*"

If Right(sourcePath, 1) <> "\" Then
sourcePath = sourcePath & "\"
End If

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(sourcePath) = False Then
MsgBox sourcePath & " does not exist "
End If
Exit Sub

If FSO.FolderExists(destinationPath) = False Then
MsgBox destinationPath & " does not exist "
End If
Exit Sub

If FSO.FileExists(sourcePath) = False Then
copy_files_from_subfolders
Else
FSO.copyfile Source:=sourcePath & fileExtn, Destination:=destinationPath
End If

MsgBox "Your files have been copied from " & sourcePath & "to" & destinationPath

End Sub

Sub copy_files_from_subfolders()
Dim FSO As Object, fld As Object
Dim fsoFile As Object
Dim fsoFol As Object

sourcePath = "\\::"
targetPath = "C:\"

If Right(sourcePath, 1) <> "\" Then
sourcePath = sourcePath & "\"
End If

Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(sourcePath)
If FSO.FolderExists(fld) Then    
          For Each fsoFol In FSO.GetFolder(sourcePath).SubFolders        
                For Each fsoFile In fsoFol.Files            
                      If Right(fsoFile, 3) = "pdf" Then            
                      fsoFile.Copy targetPath        
                End If        
                Next    
         Next
End If

End Sub

 

[burchette]

Ok. my new code is like this, but I take file not found error, on italic&bold line.

I assume the error is something like this, if you have a pdf file named like "aaa.pdf" its link on its folder must be like "C:\bbb\aaa.pdf" but in this case its searching like something "C:\bbb\.pdf" and i tried to get rid of extension part but its not the case file not found error appears again.

Can you please make a one touch punch, it must be so easy.

Sub copy_specificextension_files_in_folder()
Dim FSO As Object
Dim sourcePath As String
Dim destinationPath As String
Dim fileExtn As String


sourcePath = "C:\Users\COSTCONTROL\Desktop\asd"
destinationPath = "C:\Users\COSTCONTROL\Desktop\fas"
fileExtn = ".pdf"


If Right(sourcePath, 1) <> "\" Then
sourcePath = sourcePath & "\"
End If


Set FSO = CreateObject("Scripting.FileSystemObject")


[I][B]FSO.CopyFile Source:=sourcePath & fileExtn, Destination:=destinationPath[/B][/I]


copy_files_from_subfolders


MsgBox "Your files have been copied from " & sourcePath & "to" & destinationPath


End Sub


Sub copy_files_from_subfolders()
Dim FSO As Object, fld As Object
Dim fsoFile As Object
Dim fsoFol As Object


sourcePath = "C:\Users\COSTCONTROL\Desktop\asd"
targetPath = "C:\Users\COSTCONTROL\Desktop\fas"


If Right(sourcePath, 1) <> "\" Then
sourcePath = sourcePath & "\"
End If


Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(sourcePath)
If FSO.FolderExists(fld) Then
          For Each fsoFol In FSO.GetFolder(sourcePath).SubFolders
                For Each fsoFile In fsoFol.Files
                      If Right(fsoFile, 3) = "pdf" Then
                      fsoFile.Copy targetPath
                End If
                Next
         Next
End If


End Sub

 

[burchette]

ok, Ive come to some point. Now I am getting the error of permisson denied with the same code, because I guess of the chronological issue.

it passes sub folders while the main folder still open and getting denied, does anybody have an idea?

 

[burchette]

ok, Ive finished. Thanks to everyone for watching me I will be here again in 2 hours.