複数のフォルダを開く（VBA編）

スポンサーリンク
2019.10.05

VBAで完結します。フリーソフト等は使いません。
以前紹介した「複数のフォルダを開く（バッチ編）」では開くフォルダの位置調整ができませんでしたが、この方法では開いた後に自動で等間隔でずらして表示されます。
同時に複数のフォルダを開きっぱなしにしたい人向けです。

こんな感じ

例えば以下のフォルダを開きたい。

C:\○○試験第3相\00.DOCS
C:\○○試験第3相\10.Protocol
C:\○○試験第3相\20.aCRF
C:\○○試験第3相\30.RawData

C:\○○試験第3相\40.SDTM\41.SPEC
C:\○○試験第3相\40.SDTM\42.Main
C:\○○試験第3相\40.SDTM\42.Main\421.SRC
C:\○○試験第3相\40.SDTM\42.Main\422.Macro
C:\○○試験第3相\40.SDTM\42.Main\423.SDTM
C:\○○試験第3相\40.SDTM\43.Sub\433.SDTM
C:\○○試験第3相\40.SDTM\44.Define
C:\○○試験第3相\40.SDTM\45.P21
C:\○○試験第3相\40.SDTM\46.SDRG

C:\○○試験第3相\50.ADaM\51.SPEC
C:\○○試験第3相\50.ADaM\52.Main\521.SRC
C:\○○試験第3相\50.ADaM\52.Main\522.Macro
C:\○○試験第3相\50.ADaM\52.Main\523.ADaM
C:\○○試験第3相\50.ADaM\53.Sub\533.ADaM
C:\○○試験第3相\50.ADaM\54.Define
C:\○○試験第3相\50.ADaM\55.P21
C:\○○試験第3相\50.ADaM\56.ADRG

C:\○○試験第3相\60.TLF\61.SAP
C:\○○試験第3相\60.TLF\62.Main\621.SRC
C:\○○試験第3相\60.TLF\62.Main\622.Macro
C:\○○試験第3相\60.TLF\62.Main\623.TLF
C:\○○試験第3相\60.TLF\63.Sub\631.TLF

26個あります。上記は極端な例ですが、多くのフォルダを開き、位置を調整し、窓の大きさも調整するとかなり時間がかかります（5分くらい？）し、精神的にもまいります。
複数の試験にアサインされているときなどは、複数の試験のフォルダやファイルを同時に開いてしまうとファイルが混ざる危険性があるために、同時に開くフォルダやファイルは極力1試験分にしたい。
以下で紹介するExcelマクロを塊ごと（アサインされている試験ごととか）で作成しておくだけで一瞬（1分以内くらい）で開けます。

準備
Excelの「開発」メニューを表示する。

デフォルトでは表示されていない
Excelのファイル→オプションから設定する

表示された

VBAを起動するボタンを作る

起動ボタン設置

任意のフォルダに空のExcelファイルを作成します。
ファイルを開き、ボタンを設置します。

コードを書いていく

上記でボタンを設置すると、下のダイアログが開くので適当にマクロ名を決めて「新規作成」を押す。

上記で「新規作成」ボタンを押すと、下のようなVBAエディタが立ち上がる。

標準モジュール内のコードであることを確認。

もしも標準モジュールがなかった場合は以下の要領で追加できます。

このコードを上のエディタに貼り付け
Private Sub OpenFolders()
     Dim objW As Object
     Dim i, j As Integer

     i = 0
     j = 0

     Path01 = "C:\○○試験第3相\00.DOCS"
     Path02 = "C:\○○試験第3相\10.Protocol"
     Path03 = "C:\○○試験第3相\20.aCRF"
     Path04 = "C:\○○試験第3相\30.RawData"

     Path05 = "C:\○○試験第3相\40.SDTM\41.SPEC"
     Path06 = "C:\○○試験第3相\40.SDTM\42.Main"
     Path07 = "C:\○○試験第3相\40.SDTM\42.Main\421.SRC"
     Path08 = "C:\○○試験第3相\40.SDTM\42.Main\422.Macro"
     Path09 = "C:\○○試験第3相\40.SDTM\42.Main\423.SDTM"
     Path10 = "C:\○○試験第3相\40.SDTM\43.Sub\433.SDTM"
     Path11 = "C:\○○試験第3相\40.SDTM\44.Define"
     Path12 = "C:\○○試験第3相\40.SDTM\45.P21"
     Path13 = "C:\○○試験第3相\40.SDTM\46.SDRG"

     Path14 = "C:\○○試験第3相\50.ADaM\51.SPEC"
     Path15 = "C:\○○試験第3相\50.ADaM\52.Main\521.SRC"
     Path16 = "C:\○○試験第3相\50.ADaM\52.Main\522.Macro"
     Path17 = "C:\○○試験第3相\50.ADaM\52.Main\523.ADaM"
     Path18 = "C:\○○試験第3相\50.ADaM\53.Sub\533.ADaM"
     Path19 = "C:\○○試験第3相\50.ADaM\54.Define"
     Path20 = "C:\○○試験第3相\50.ADaM\55.P21"
     Path21 = "C:\○○試験第3相\50.ADaM\56.ADRG"

     Path22 = "C:\○○試験第3相\60.TLF\61.SAP"
     Path23 = "C:\○○試験第3相\60.TLF\62.Main\621.SRC"
     Path24 = "C:\○○試験第3相\60.TLF\62.Main\622.Macro"
     Path25 = "C:\○○試験第3相\60.TLF\62.Main\623.TLF"
     Path26 = "C:\○○試験第3相\60.TLF\63.Sub\631.TLF"

     With CreateObject("Shell.Application")
         .Open Path01
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path02
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path03
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path04
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path05
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path06
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path07
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path08
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path09
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path10
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path11
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path12
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path13
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path14
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path15
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path16
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path17
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path18
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path19
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path20
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path21
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path22
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path23
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path24
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path25
         Application.Wait Now() + TimeValue("0:00:01")
         .Open Path26

         Application.Wait Now() + TimeValue("0:00:02")
         For Each objW In .Windows
             If InStr(TypeName(objW.Document), "ShellFolder") > 1 Then
                 objW.Left = 400 + i
                 objW.Top = 0 + j
                 objW.Height = 300
                 objW.Width = 850
                 i = i + 30
                 j = j + 30
             End If
         Next
     End With
End Sub

Sub ボタン1_Click()
    Module1.OpenFolders
End Sub

かなり冗長なコードですが、動きます。
VBAが本職ではないのでこれでよいです。

解説1
     Path01 = "C:\○○試験第3相\00.DOCS"

この部分に開きたいフォルダを絶対パスで記述します。
複数のパスのときは変数名を連番にします。
Path01,Path02,・・・,PathXX

解説2
     With CreateObject("Shell.Application")
         .Open Path01
         Application.Wait Now() + TimeValue("0:00:01")
     ・
     ・
     ・

.Open Path01
で指定されたフォルダを開いています。

Application.Wait Now() + TimeValue(“0:00:01”)
で指定された時間だけWaitを入れます。
これがないとPC環境によっては実行洩れが発生します。
開きたいフォルダの数だけ書きます。
ループにすべきですが、わからなかったのでこのままにしています。

解説3
         For Each objW In .Windows
             If InStr(TypeName(objW.Document), "ShellFolder") > 1 Then
                 objW.Left = 400 + i
                 objW.Top = 0 + j
                 objW.Height = 300
                 objW.Width = 850
                 i = i + 30
                 j = j + 30
             End If
         Next

開いたすべてのフォルダに対して開いた順に位置と大きさを調整しています。モニタの大きさによって最適値は異なるので、座標と大きさは試しながら調整してください。
※すべてのフォルダが対象となるので、このマクロ以外で開かれていたフォルダも調整されてしまうので注意。

解説4
Sub ボタン1_Click()
    Module1.OpenFolders
End Sub

ワークシートに設置したボタンが押されると、このコードが呼ばれます。
内部でOpenFoldersが呼ばれることで本体に処理が移ります。

保存する際はマクロ有効(.xlsm)として保存します。

最初に作成したxlsxファイルは不要なので削除します。
もっとよい作成方法があると思いますが、動けばよいのでこれでよしとします。

使い方

ファイルを開くとセキュリティの警告がでるので「コンテンツの有効化」を押します。
作成したボタンを押すことでマクロが実行されます。

登録したフォルダが開かれ、位置と大きさも自動調整されました。

もちろんフォルダを選択する場合は画面上の該当部分のクリックだけでなく、タスクバー上からでも可能です。

スポンサーリンク

コメント