S
Steve
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
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