Sub MSIToIMDS()
Application.ScreenUpdating = False
Dim OldPath As String
Dim NewPath As String
Dim OldName As String
Dim NewName As String
Dim x As String
Dim i As Integer
Dim xconvention
'set file path

OldPath = "C:\test" '"C:\MSIReportNameConvert\MSI_Input\"
NewPath = "C:\MSIReportNameConvert\IMDS_Output\"

With Application.FileSearch
.NewSearch
.LookIn = OldPath
.SearchSubFolders = False 'True
.MatchTextExactly = False

.Filename = "*.*"
If .Execute(msoSortOrderDescending) 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
On Error Resume Next
For i = 1 To .FoundFiles.Count
OldName = .FoundFiles(i)

xconvention = Format(Date, "MMDDYY_")
NewName = NewPath & xconvention & Mid(OldName,
InStrRev(OldName, "\") + 1)
Name OldName As NewName
Next i
Else
MsgBox "There were no files found."
End If
End With
Application.ScreenUpdating = True
End Sub


--
__________________________________
HTH

Bob

"Steve" wrote in message
...
This code is suppose to move and rename all files to a different
directory with todays date in the format of "mmyydd_" in the front of
each file. When the code runs it find all my files but the files are
not renamed or moved. What am I doing wrong?

Thanks
Steve

****CODE START HERE****

Sub MSIToIMDS()
Application.ScreenUpdating = False


Dim OldName As String
Dim NewName As String
Dim x As String
Dim i As Integer
'set file path

Oldpath = "C:\MSIReportNameConvert\MSI_Input\"
Newpath = "C:\MSIReportNameConvert\IMDS_Output\"


With Application.FileSearch
.NewSearch
.LookIn = Oldpath
.SearchSubFolders = False 'True
.MatchTextExactly = False


.Filename = "*.*"
If .Execute(msoSortOrderDescending) 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
On Error Resume Next
For i = 1 To .FoundFiles.Count
OldName = .FoundFiles(i)


xconvention = Format(Date, "MMDDYY_")
NewName = Newpath & xconvention & OldName
Name OldName As NewName
Next i
Else
MsgBox "There were no files found."
End If
End With
Application.ScreenUpdating = True
End Sub