vba code-copy files from folder and sub folders

burchette

New Member
Joined
May 30, 2018
Messages
11
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.

Code:
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
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

burchette

New Member
Joined
May 30, 2018
Messages
11
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.

Code:
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

New Member
Joined
May 30, 2018
Messages
11
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

New Member
Joined
May 30, 2018
Messages
11
ok, Ive finished. Thanks to everyone for watching me :) I will be here again in 2 hours.
 

Watch MrExcel Video

Forum statistics

Threads
1,132,896
Messages
5,655,850
Members
418,247
Latest member
The_aze

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top