自Bookのフォルダを開くExcelアドイン

VBA

既出も既出だろうけど、ふと思いついたんで、作ってみた。

機能

自Bookが置かれているフォルダを開きます。ただそれだけ。(；^ω^)
保存していないファイル上で実行すると、Explorerが起動します。

ソース

'ThisWorkbook Module
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Const cnsMenuName As String = "My Folder Oepner"         'Cellsバーに追加する際のメニュー名
    
    On Error Resume Next
    Application.CommandBars("Cell").Controls(cnsMenuName).Delete
    On Error GoTo 0
    
End Sub

Private Sub Workbook_Open()
    
    Const cnsMenuName As String = "My Folder Oepner"         'Cellsバーに追加する際のメニュー名
    Const cnsFaceID   As Long = 1923                         'アイコンのFaceID
    Const cnsTipText  As String = "当該ブックが保存されているフォルダを開きます"  'ツールチップテキスト
    Const cnsProcName As String = "MyFolderOpener"           'プロシージャー名
    
    Dim cbCell        As CommandBar
    Dim cbNewMenu     As CommandBarButton
    
    Set cbCell = Application.CommandBars("Cell")

    '新規作成するメニューを予め削除しておく
    On Error Resume Next
    cbCell.Controls(cnsMenuName).Delete
    On Error GoTo 0
    
    Set cbNewMenu = cbCell.Controls.Add(Type:=msoControlButton)
    
    With cbNewMenu
        .TooltipText = cnsTipText
        .FaceId = cnsFaceID
        .Caption = cnsMenuName
        .OnAction = cnsProcName
    End With
    
    Set cbNewMenu = Nothing
    Set cbCell = Nothing

End Sub

'標準Module
Option Explicit

Sub MyFolderOpener()

    Dim strMyPath As String

    On Error Resume Next
    strMyPath = ActiveWorkbook.Path
    Shell "explorer " & strMyPath, vbNormalFocus
    On Error GoTo 0

End Sub

使い方

アドインを参照させると、セル上での右クリメニュー中に、ひょっこり
「My Folder Opener」ってのが追加されるので、それをクリックするだけ。

動作確認

Win2k & Excel2k で動作確認してます。
WinXP & Excel2003 でもokでした。Vistaはわかんないっす(；^ω^)

よければ

ここからどうぞ。