開いているWord文書のショートカットをデスクトップにつくるマクロ

編集中のドキュメント、あしたすぐに開きたいという場合、ショートカットをつくりたい。
マクロでワンクリックでつくれるので、便利。

Sub MakeShort()
    Dim ShellObject
    Set ShellObject = CreateObject("WScript.Shell")
    
    Dim TempPath As String
    TempPath = ShellObject.SpecialFolders("Desktop")
    
    Dim ShortcutObject
    Set ShortcutObject = ShellObject.CreateShortcut(TempPath & "\" & ActiveDocument.Name & ".lnk")
    
    With ShortcutObject
        .TargetPath = ActiveDocument.FullName
        .Save
    End With
End Sub

ショートカットをつくっておけば、コピーが散乱してどれが本元なのかを見失わずに済むからよい。
ちなみに、ActiveDocumentをActiveWorkbookに変えると、そのままExcelで同様のことができる。
地味に便利。