What is wrong with this code?

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
 
J

JLGWhiz

If your new path is using an existin directory then you could use the Move
method to put the file there after you rename it. Otherwise, you would need
to use MkDir to set up the new directory and then move the file. I don't
think you can reassign directiories by renaming only.
 
N

NoodNutt

G'day Steve

Try this

Dim OldName As String
Dim NewName As String
Dim x As String
Dim i As Integer
Dim FileYes As Integer
Dim FileNo As Integer

With Application
..ScreenUpdating = False
..EnableEvents = False
End With

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

With Application.FileSearch
.NewSearch
.LookIn = Oldpath
.SearchSubFolders = False 'True
.MatchTextExactly = False
.Filename = "*.*"
If .Execute(msoSortOrderDescending) > 0 Then
FileYes = MsgBox ("There were " & .FoundFiles.Count & " file(s)
found.",vbOKOnly)
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
FileNo = MsgBox ("There were no files found.",vbOKOnly)
End If
End With

With Application
..ScreenUpdating = False
..EnableEvents = False
End With

End Sub

HTH
Mark.
 
B

Bob Phillips

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top