Error handling - renaming files and moving to new location

[keaveneydan]

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

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