VBAで開いてる全てのブックのパスを取得する

開いていたブックが分からない

Excelでの作業を行う場合に、複数のブックを開いて作業することがあります。編集するブックは１つだけど、参考にするブックが複数あったり、とかのように、編集用と参照用が分かれることがよくあります。

そのような作業をしているときに、以下のような状況でどうしてもすぐにブックを閉じないといけなくなる場合があります。

Excelの調子が悪くなりExcelの再起動をしたい場合
開いているブックがサーバにあるため他の人が編集したいと言っている場合
PCの再起動が必要になった場合
別の作業が入ってしばらくExcelの作業ができない場合

一度閉じてしまうので、再度見たい場合には開きなおす必要があるのですが、前回開いていたブックの数が多いと、再度開くときにどれを開いていたのか探すのが面倒ですし、そもそも開いていたことを忘れていることもあります。

また、ファイルサーバに保存されているブックの場合では、フォルダがあちこちに分かれているのはよくあります。使ったのが直前であれば「最近使ったアイテム」の一覧から探すこともできますが、これが何日も前だったり開くブックの数が多数だったりすると、一覧には残っていないことがあります。

そのような場合に、今開いている全てのブックのフルパスを取得しておくと、あとで開きなおすブックがどれなのかを分かるため大変便利ですし、探す手間も省けます。

以下で、開いている全てのブックのパスを取得するコードを紹介します。

開いている全てのブックのパスを取得する

以下のSaveBookList関数を実行すると、現在開いている全てのブックのパスを新しいブックに保存します。保存先はデスクトップです。ブック名には日時が付けられます。

関数が２つありますが、２つ目のGetBookList関数は開いているブックのパスを取得して配列に格納する関数で、１つ目の関数は配列に格納されたブックのパスを新規ブックに書き込んで保存する関数です。

配列に保存されたブックのパスは、新規ブックのA1セルから、A2セル、A3セル、と下に向かって書き込みます。

'// 開いている全てのブックのパスを新規ブックに保存する
Sub SaveBookList()
    Dim sArPath()   As String       '// ブックパス配列
    Dim sPath       As Variant      '// ブックパス
    Dim wb          As Workbook     '// 新規作成ワークブック
    Dim sSavePath   As String       '// 保存するブックのパス
    
    '// 開いている全てのブックのパスを取得
    Call GetBookList(sArPath)
    
    '// 新規ブック追加
    Set wb = Workbooks.Add
    
    For Each sPath In sArPath
        ActiveCell.Value = sPath
        ActiveCell.Offset(1, 0).Select
    Next
    
    '// デスクトップに"BookList-YYYYMMDD-HHMMSS.xlsx"の名前のブックパスを作成
    sSavePath = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\BookList-" & Format(Now, "YYYYMMDD-HHMMSS") & ".xlsx"
    
    '// 保存
    Call wb.SaveAs(Filename:=sSavePath)
    
    '// ブックを閉じる
    Call wb.Close
End Sub

'// 開いている全てのブックのパスを取得
Sub GetBookList(a_sArPath() As String)
    Dim wb      As Workbook     '// ブック
    
    '// 引数の配列を初期化
    ReDim a_sArPath(0)
    a_sArPath(0) = Empty
    
    '// 開いている全てのブックをループ
    For Each wb In Workbooks
        '// ブック名をフルパスで取得
        a_sArPath(UBound(a_sArPath)) = wb.FullName
        
        '// 配列を拡張
        ReDim Preserve a_sArPath(UBound(a_sArPath) + 1)
    Next
    
    '// 配列に格納済みの場合
    If IsEmpty(a_sArPath(0)) = False Then
        '// 余分に拡張された領域を削除
        ReDim Preserve a_sArPath(UBound(a_sArPath) - 1)
    End If
End Sub

'// 開いている全てのブックのパスを新規ブックに保存する

Sub SaveBookList()

Dim sArPath() As String '// ブックパス配列

Dim sPath As Variant '// ブックパス

Dim wb As Workbook '// 新規作成ワークブック

Dim sSavePath As String '// 保存するブックのパス

'// 開いている全てのブックのパスを取得

Call GetBookList(sArPath)

'// 新規ブック追加

Set wb = Workbooks.Add

For Each sPath In sArPath

ActiveCell.Value = sPath

ActiveCell.Offset(1, 0).Select

'// デスクトップに"BookList-YYYYMMDD-HHMMSS.xlsx"の名前のブックパスを作成

sSavePath = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\BookList-" & Format(Now, "YYYYMMDD-HHMMSS") & ".xlsx"

'// 保存

Call wb.SaveAs(Filename:=sSavePath)

'// ブックを閉じる

Call wb.Close

End Sub

'// 開いている全てのブックのパスを取得

Sub GetBookList(a_sArPath() As String)

Dim wb As Workbook '// ブック

'// 引数の配列を初期化

ReDim a_sArPath(0)

a_sArPath(0) = Empty

'// 開いている全てのブックをループ

For Each wb In Workbooks

'// ブック名をフルパスで取得

a_sArPath(UBound(a_sArPath)) = wb.FullName

'// 配列を拡張

ReDim Preserve a_sArPath(UBound(a_sArPath) + 1)

'// 配列に格納済みの場合

If IsEmpty(a_sArPath(0)) = False Then

'// 余分に拡張された領域を削除

ReDim Preserve a_sArPath(UBound(a_sArPath) - 1)

End If

End Sub

実行結果

実行するとデスクトップに「Booklist-YYYYMMDD-HHMMSS.xlsx」のファイルが保存されます。

上記の関数で保存されたブックには、開いていた全てのブックのパスが含まれます。

そのため、個人用マクロブック（PERSONAL.XLSB）を利用している場合はそのパスも含まれます。未保存のブックにはパスが無いので、Book1などのような名前だけが書き込まれます。

開いていたブックが分からない

開いている全てのブックのパスを取得する

実行結果

関連記事