keaveneydan
Board Regular
- Joined
- Apr 29, 2014
- Messages
- 144
Hi
I am trying to automate a process and it works 80% of the time. The macro goes to a directory location and renames each file using it's lastmodified date. However the macro seems to trip itself up by renaming and moving a file and then trying to open it again from it's previous location....but it isn't there anymore.
Can anyone help with a good error handling solution that won't
1. Just kill the macro
2. Let the mcaro run continuously when all the files have been moved
Something like End and then start again from beginning
Thanks
I am trying to automate a process and it works 80% of the time. The macro goes to a directory location and renames each file using it's lastmodified date. However the macro seems to trip itself up by renaming and moving a file and then trying to open it again from it's previous location....but it isn't there anymore.
Can anyone help with a good error handling solution that won't
1. Just kill the macro
2. Let the mcaro run continuously when all the files have been moved
Something like End and then start again from beginning
Thanks
Code:
Sub RenamePortFiles()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim FilePath As String
Dim StopMacro As Boolean
Dim CurrentFile As String
Dim FileDate As String
FilePath = "S:\Market_Funds\PORT Data\FTP download\"
If Len(Dir(FilePath & "Renamed Files", vbDirectory)) = 0 Then
MkDir (FilePath & "Renamed Files")
End If
Do Until StopMacro = True
CurrentFile = Dir(FilePath & "*.xlsx")
If CurrentFile = "" Then
MsgBox "All Excel Files renamed.", vbOKOnly + vbCritical, "No Excel Files Found"
Exit Sub
End If
Workbooks.Open FILENAME:=FilePath & CurrentFile
Dim FSO As New FileSystemObject
Dim aFile As File
Set aFile = FSO.GetFile(FilePath & CurrentFile)
FileDate = Format(aFile.DateLastModified - 1, "YYYYMMDD")
ActiveWorkbook.SaveAs FILENAME:=FilePath & "Renamed Files\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 13) & " " & FileDate
Set aFile = Nothing
ActiveWorkbook.Close
Kill FilePath & CurrentFile
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub