VBA解决方案，用于快速重命名活动Office文档文件(Word，Excel，PowerPoint) [英] VBA Solution for quick rename of active office document file (Word, Excel, PowerPoint)

问题描述

在Microsoft Office Suite应用程序(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.

显然，这导致需要单击快速选项，该选项允许重新命名文件，这也将删除旧文件或覆盖现有文件. AFAIK Office套件应用程序/Windows资源管理器不允许在打开文件时重命名该文件(文件已锁定).因此，据我了解并从本论坛的其他类似问题中阅读，这可能是技术限制，可能无法重命名活动(锁定)文件.但是，我在Sumatra PDF阅读器中看到了这样的解决方案，其中文件为PDF，按F2按钮不仅可以重命名，还可以选择保留重命名文件的文件夹(原始文件夹或其他位置)，而无需复制任何文件.我很期待他们的类似VBA命令是否能够至少在原始位置重命名文件，或者在重命名过程中进行某种自动化，从而避免重复和/或最小化重命名所需的工作.搜索但看不到任何用于自动重命名过程的Office套件本机内置内置快捷键/命令.最近，我发现VBA命令Shell Environ("windir") & "\Explorer.exe " & ActiveDocument.Path, vbMaximizedFocus仅允许定位当前打开文件的文件夹位置，但是它不选择/突出显示该特定文件，并且很难区分该文件夹中是否存在类似的其他文件.预先感谢您的支持.

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.

推荐答案

正确的方法不是通过Explorer Shell，而是:

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

• 1)将文档的完整路径存储在字符串中:oldfile = ActiveDocument.FullName

2)使用ActiveDocument.SaveAs

3)使用Kill oldfile

所有这些都直接来自VBA，无需使用资源管理器外壳.

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.

您可以使用它来重命名Excel文档:

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

与此非常相似的是PPT:

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

为了使它完整，这是同一件事的Word宏:

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

这篇关于VBA解决方案，用于快速重命名活动Office文档文件(Word，Excel，PowerPoint)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！