Rename PDF file

[keaveneydan]

Hi

I thought I had a nice bit of code that will rename PDF files for me. It does rename my file accordingly however I get an error when I try to open them saying they are damaged and could not be repaired. The macro, or a variation of it, works perfectly for excel files of the same name.

Thanks

Sub RenamePDFFiles()
Application.DisplayAlerts = False
        Application.ScreenUpdating = False
Dim FilePath As String
Dim StopMacro As Boolean
Dim CurrentFile As String
Dim FileDate As String
Dim FSO As New FileSystemObject
Dim aFile As File
On Error GoTo ErrorHandler
    
    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 & "*.pdf")
        If CurrentFile = "" Then
            MsgBox "All PDF Files renamed.", vbOKOnly + vbCritical, "No PDF Files Found"
            Exit Sub
        End If
            Workbooks.Open FILENAME:=FilePath & CurrentFile
            Set aFile = FSO.GetFile(FilePath & CurrentFile)
            'If Weekday(Now(), vbMonday) = 1 Then
            'FileDate = Format(aFile.DateLastModified - 3, "YYYYMMDD")
            'Else
            'FileDate = Format(aFile.DateLastModified - 1, "YYYYMMDD")
            'End If
            Set aFile = FSO.GetFile(FilePath & CurrentFile)
            If Weekday(aFile.DateLastModified, vbSaturday) = 1 Then
            FileDate = Format(aFile.DateLastModified - 1, "YYYYMMDD")
            ElseIf Weekday(aFile.DateLastModified, vbMonday) = 1 Then
            FileDate = Format(aFile.DateLastModified - 3, "YYYYMMDD")
            ElseIf Weekday(aFile.DateLastModified, vbSunday) = 1 Then
            FileDate = Format(aFile.DateLastModified - 2, "YYYYMMDD")
            Else
            FileDate = Format(aFile.DateLastModified - 1, "YYYYMMDD")
            End If
            ActiveWorkbook.SaveAs FILENAME:=FilePath & "Renamed Files\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 12) & " " & FileDate & (".pdf")
                Set aFile = Nothing
            ActiveWorkbook.Close
        Kill FilePath & CurrentFile
        Application.Wait (Now + TimeValue("0:00:01"))
    Loop
    
ErrorHandler:
If Err.Number <> 0 Then
Msg = Str(Err.Number)
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
Resume Next
    
    Application.DisplayAlerts = True
        Application.ScreenUpdating = True
End Sub