See if this works then
Sub resave()Dim strDate As String
Dim strFilePath As String
Dim L As Long
Dim iPos As Integer
Dim strName As String
Dim strSuffix As String
Dim oPres As Presentation
Const Folderpath As String = "C:\Users\John_Dell\Desktop\Files\"
Const strSpec As String = "*.ppt*"
On Error Resume Next
MkDir Folderpath & "\Resaved Files"
'First match
strFilePath = Dir$(Folderpath & strSpec)
While strFilePath <> ""
strName = ""
Set oPres = Presentations.Open(FileName:=Folderpath & strFilePath, WithWindow:=False)
iPos = InStrRev(oPres.Name, ".")
strSuffix = Mid(oPres.Name, iPos)
strName = Left(oPres.Name, iPos - 1)
strName = clean(strName)
MsgBox strName
If strName = "" Then strName = "Slide1"
strDate = oPres.BuiltInDocumentProperties("Last save time")
strDate = Format(strDate, "mmm dd yyyy hh_mm")
oPres.SaveCopyAs Folderpath & "Resaved Files\" & strName & strDate & strSuffix
oPres.Close
strFilePath = Dir$
Wend
End Sub
Function clean(strIn As String) As String
clean = strIn
Select Case True
Case InStr(strIn, "\") > 0
clean = Replace(strIn, "\", "")
Case InStr(strIn, "/") > 0
clean = Replace(strIn, "/", "")
Case InStr(strIn, "?") > 0
clean = Replace(strIn, "?", "")
Case InStr(strIn, "|") > 0
clean = Replace(strIn, "|", "")
Case InStr(strIn, "*") > 0
clean = Replace(strIn, "*", "")
Case InStr(strIn, "<") > 0
clean = Replace(strIn, "<", "")
Case InStr(strIn, ">") > 0
clean = Replace(strIn, ">", "")
End Select
End Function