Need to Copy Files (all Subfolders and Files)
Try using the sheel command COPY
windir = Environ("windir")
Mycmd = "copy c:\temp\boo*.xls c:\temp\working"
Shell windir & "\system32\cmd.exe" & " " & Mycmd
"Benjamin" wrote:
Also - I don't want to overwrite the whole folder,
just existing files that match my source directories file names.
"Benjamin" wrote:
Need help tweaking this code:
I understand there's the
Copyfile and Copyfolder function,
who do I integrate that to copy all files and subfolders
from a certain source directory.
Option Explicit
'Copy ALL files (or of a specific file type) in one folder into another folder
Sub CopyFilesFolder2Folder()
'Declare Variables
Dim FSO
Dim sfol As String, dfol As String
Dim FrmFolder As String, ToFolder As String
Dim C_Row As String 'Row Counter
'<<Starting Variable Settings
C_Row = "2"
'<<---Start Loop--
'Do Until IsEmpty(Cells(C_Row, 2))
FrmFolder = Worksheets("Settings").Cells(C_Row, 2)
'MsgBox FrmFolder
ToFolder = Worksheets("Settings").Cells(C_Row, 3)
'MsgBox ToFolder
sfol = FrmFolder ' change to match the source folder path
dfol = ToFolder ' change to match the destination folder path
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If Not FSO.FolderExists(sfol) Then 'Source Folder
MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid
Source"
ElseIf Not FSO.FolderExists(dfol) Then 'Destination Folder
MkDir (dfol) 'Makes Directory if it Isn't Created.
FSO.CopyFile (sfol & "\*.*"), dfol 'Copies Files
Else
FSO.CopyFile (sfol & "\*.*"), dfol ' Change "\*.*" to "\*.xls" to move
Excel Files only
End If
If Err.Number = 53 Then MsgBox "File not found: " & sfol & " " & dfol
'--Add 1 to Row Counter
'C_Row = C_Row + 1
'Loop
'<<---End Loop--
End Sub
|