Prompted by the suggestions of @Adam and @Lưu Vĩnh Phúc, I created the following macro that does what you requested. Note that this will delete any history associated with the file.
' Renames the current file without closing the document (assuming file has already been saved)
' (Actually, saves with new name and deletes previous, so history will be lost).
Dim strFileFullName, strFileName, strNewName As String
Dim res As VbMsgBoxResult
' Get current name:
strFileFullName = ActiveDocument.FullName 'for Word docs
'strFileFullName = ActiveWorkbook.FullName 'for Excel docs
'strFileFullName = Application.ActivePresentation.FullName 'for Powerpoint presentations*
If (InStr(strFileFullName, ".") = 0) Then
res = MsgBox("File has not been saved. Can't rename it.", , "Rename File")
strFileName = Right(strFileFullName, Len(strFileFullName) - InStrRev(strFileFullName, "\")) 'strip path
strFileName = Left(strFileName, (InStr(strFileName, ".") - 1)) ' strip extension
' Prompt for new name:
strNewName = InputBox("Rename this file to:", "Rename File", strFileName)
If (strNewName = "") Or (strNewName = strFileName) Then ' (Check whether user cancelled)
' Save file with new name:
ActiveDocument.SaveAs2 FileName:=strNewName 'for Word docs
'ActiveWorkbook.SaveAs2 FileName:=strNewName 'for Excel docs
'Application.ActivePresentation.SaveAs FileName:=strNewName 'for Powerpoint presentations*
' Delete old file:
With New FileSystemObject ' (this line requires: Tools->References->Microsoft scripting runtime)
If .FileExists(strFileFullName) Then
*Note: although this macro works with Powerpoint (with modifications noted above), PowerPoint can't save it globally.