[COLOR=blue]
Public Function MoveAndRenameMyFile(SourcePath As String, SourcePattern As String, Destination As String) As Boolean
[/color][COLOR=green]
'=======================================================
'Call MoveAndRenameMyFile("C:\My Documents\", "File2*.xls", "C:\My Documents\Sales\Processed2.xls")
'=======================================================
[/color][COLOR=blue]
Dim oFso As Object
Dim MyFile As String
On Error GoTo ErrorOut
Set oFso = CreateObject("Scripting.FileSystemObject")
MyFile = Dir(SourcePath & SourcePattern)
'Loop until a matching file is found
Do Until LenB(MyFile) = 0
'Pattern matching check
If UCase$(MyFile) Like UCase$(SourcePattern) Then
'Found a similar file. Make sure we are not copying it to the same location
If StrComp(SourcePath & MyFile, Destination, vbTextCompare) <> 0 Then
'Copy to new location, OVERWRITING any file with the same name.
'Then DELETE the original
Call oFso.CopyFile(SourcePath & MyFile, Destination, True)
Call oFso.DeleteFile(SourcePath & MyFile, True)
Else
'Failed!
Err.Raise vbObjectError + 512 + 101, "MoveAndRenameMyFile", "Source and Destination identical"
End If
'Success
Exit Do
End If
Call Dir
Loop
ErrorOut:
If Err.Number <> 0 Then
Err.Raise Err.Number, "MoveAndRenameMyFile", Err.Description
Else
If LenB(MyFile) = 0 Then
'Failed!
'MsgBox "No File Found"
Err.Raise vbObjectError + 512 + 101, "MoveAndRenameMyFile", "No File Found"
Else
MoveAndRenameMyFile = True 'Success!
End If
End If
End Function
[/color]