CODEWITHSUNDEEP
excelms-wordvba
Rhinemine
Rhinemine

Reputation: 73

VBA Solution for quick rename of active office document file (Word, Excel, PowerPoint)

File rename is often requires while working on Microsoft Office Suite applications (Word, Excel, PowerPoint). Usually “Files > Save as” allows rename the file but it also create duplication since the original file remain there and there is no simultaneous options to delete the original file. Although this option is currently in practice but for quick and convenient rename without any duplication of same file the current available option is not adequate. Close the file, remember its name and locate that file in the residing specific directory (where file is masked by similar other files) is possible but the approach is very time consuming and not a good solution to improve productivity.

Obviously that leads to need of a single click quick option which would allow rename of the file which would also delete the old file or overwrite on existing file. AFAIK the Office suite applications / Windows explorer does not allow renames the file while it opens (file locked). So to my understanding and reading from other similar questions in this forum this is might be technical limitation and might not possible to rename active (locked) file. However I have seen a solution of this kind in Sumatra PDF reader where the file is PDF and pressing F2 button allows not only rename but also option to choose the folder where to keep the renamed file (original folder or elsewhere) without any duplication of file. I am looking forward if their similar VBA commands which would do at least rename the file at original location or some sort of automation in rename process which avoid duplication and/or minimize the efforts necessary to rename. Searched but could not see any Office suite native built-in shortcut key/command to automate the rename process. Closest I found VBA command Shell Environ("windir") & "\Explorer.exe " & ActiveDocument.Path, vbMaximizedFocus allow to locate the folder location only of currently opened file but it does not select/highlight that specific file and difficult to distinguish if there similar other files in that folder. Thanks in advance for your support contribution.

Upvotes: 1

Views: 9265

Answers (1)

ib11
ib11

Reputation: 2568

The correct approach is not via the Explorer shell, instead:

  • 1) Store the full path of the document in a string: oldfile = ActiveDocument.FullName

  • 2) SaveAs the document with ActiveDocument.SaveAs

  • 3) Delete the old file with Kill oldfile

All this is from VBA directly, no need to use Explorer shell.

Below are the full codes for all three applications, with prompting the SaveAs dialog, but then also deleting the old file.

You can use this to rename the Excel document:

Sub RenameActiveWorkBook()

    Dim oldfile As String

    Set myWbook = ActiveWorkbook

    If myWbook.Path = "" Then
        On Error Resume Next
        myWbook.Save
        Exit Sub
    End If

    '1) store current file
    oldfile = myWbook.FullName

    '2) save as the active document (prompt user for file name)
    Application.FileDialog(msoFileDialogSaveAs).InitialFileName = oldfile
    If Application.FileDialog(msoFileDialogSaveAs).Show = 0 Then Exit Sub
    Application.FileDialog(msoFileDialogSaveAs).Execute
    If oldfile = myWbook.FullName Then Exit Sub
    'ONLY RENAME: myWbook.SaveAs Filename:=myWbook.Path & Application.PathSeparator & InputBox("Enter new name", "Rename current document", myWbook.Name), AddToMru:=True

    '3) Delete the old file with
    On Error GoTo FileLocked
    Kill oldfile
    On Error GoTo 0

    Exit Sub

FileLocked:
    MsgBox "Could not delete " & oldfile, vbInformation + vbOKOnly, "File is locked"

End Sub

And very similar to this is the PPT:

Sub RenameActivePresentation()

    Dim oldfile As String

    Set myPPT = ActivePresentation

    If myPPT.Path = "" Then
        On Error Resume Next
        Application.FileDialog(msoFileDialogSaveAs).Show
        Application.FileDialog(msoFileDialogSaveAs).Execute
        Exit Sub
    End If

    '1) store current file
    oldfile = myPPT.FullName

    '2) save as the active document (prompt user for file name)
    Application.FileDialog(msoFileDialogSaveAs).InitialFileName = oldfile
    If Application.FileDialog(msoFileDialogSaveAs).Show = 0 Then Exit Sub
    Application.FileDialog(msoFileDialogSaveAs).Execute
    If oldfile = myPPT.FullName Then Exit Sub
    'ONLY RENAME: myPPT.SaveAs FileName:=myPPT.Path & "\" & InputBox("Enter new name", "Rename current document", myPPT.Name)

    '3) Delete the old file with
    On Error GoTo FileLocked
    Kill oldfile
    On Error GoTo 0

    Exit Sub

FileLocked:
    MsgBox "Could not delete " & oldfile, vbInformation + vbOKOnly, "File is locked"

End Sub

And just to have it complete, here is the Word macro for the same thing:

Sub RenameActiveDoc()

    Dim oldfile As String

    Set myDoc = ActiveDocument

    If myDoc.Path = "" Then
        On Error Resume Next
        myDoc.Save
        Exit Sub
    End If

    '1) store current file
    oldfile = myDoc.FullName

    '2) save as the active document (prompt user for file name)
    Application.FileDialog(msoFileDialogSaveAs).InitialFileName = oldfile
    If Application.FileDialog(msoFileDialogSaveAs).Show = 0 Then Exit Sub
    Application.FileDialog(msoFileDialogSaveAs).Execute
    If oldfile = myDoc.FullName Then Exit Sub
    'ONLY RENAME: myDoc.SaveAs FileName:=myDoc.Path & Application.PathSeparator & InputBox("Enter new name", "Rename current document", myDoc.Name)

    '3) Delete the old file with
    On Error GoTo FileLocked
    Kill oldfile
    On Error GoTo 0

    Exit Sub

FileLocked:
    MsgBox "Could not delete " & oldfile, vbInformation + vbOKOnly, "File is locked"

End Sub

Upvotes: 1

Related Questions