Copy files from one Dir to another, selected filepattern,
NO FSO
'"*.*" all files
'"*.txt" text files
'"*.exe" you get the idea!
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Private Sub Command1_Click()
CopyFiles "c:\", "c:\a\", "*.*"
End Sub
Private Sub CopyFiles(SourceDir As String, DestDir As String, ThisPattern As String)
On Error GoTo ErrHandler
Dim Thisfile As String
Dim arr() As String
Dim x As Integer
If Right$(SourceDir, 1) <> "\" Then SourceDir = SourceDir + "\"
If Right$(DestDir, 1) <> "\" Then DestDir = DestDir + "\"
Thisfile = Dir$(SourceDir + ThisPattern, 0)
Do While Thisfile <> ""
ReDim Preserve arr(x)
arr(x) = Thisfile
x = x + 1
Thisfile = Dir$
Loop
MakeDir (DestDir)
For x = 0 To UBound(arr())
FileCopy SourceDir & arr(x), DestDir & arr(x)
Next x
Exit Sub
ErrHandler:
MsgBox "An Error Occured: " & Err.Number & " " & Err.Description
End Sub
Public Function MakeDir(strPath As String) As Boolean
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\" 'Make sure ends with "\"
End If
MakeSureDirectoryPathExists (strPath) 'Make the dir
If Dir(strPath, vbDirectory) <> "" Then MakeDir = True 'Check dir exists
End Function 'returns true/false