読者です 読者をやめる 読者になる 読者になる

フォルダ構成を別のフォルダにコピーするマクロ(3)

一覧表のデータを元にフォルダ構成を移植する

いよいよ今回のマクロも完成。

今回は、前回のマクロで作成したフォルダの一覧表を元に、別のフォルダにフォルダ構成を再現する処理を書いていく。

処理の下準備

リスト1-1
Sub moveFolderStructure()
  Dim objSh As Worksheet
  Set objSh = ActiveSheet
  With objSh
    If .Range("A3").Value = "" Then    '……(1)
      MsgBox "フォルダフルパスが空白なので処理できません。", vbCritical
      Exit Sub
    End If
    Dim lastRw As Integer
    lastRw = .Cells(Rows.Count, 1).End(xlUp).Row    '……(2)
  End With
リスト1-1の説明

処理を始めるための準備みたいなところ。

  • (1)は、A3セルが空白かどうかで条件分岐。A3セルに何も入っていなければ、そもそもフォルダ構成が取得できていないということなので、メッセージを表示して処理を終える。
  • (2)はおなじみ、データのある最終行番号を求める計算。データ転記系の処理ではマジでよく使うので、入門者は理屈とともに手が勝手に動くレベルまで習熟すべし。

コピー先の親フォルダのフルパス取得

当ブログではもはやおなじみ、FolderPickerクラスを使う。

リスト1-2
  Dim rootPath As String
  Set fldPicker = New FolderPicker    '……(1)
  MsgBox "フォルダ構成のコピー先となる親フォルダを指定せよ。"
  With fldPicker
    .showFolderPicker    '……(2)
    If .isCancelled = True Then    '……(3)
      Exit Sub
    End If
    rootPath = fldPicker.gotFolder    '……(4)
  End With
リスト1-2の説明

もはや説明不要かも知れんけど、一応。

  • (1)はおなじみ、FolderPickerクラスをインスタンス化。ひつこいようだけど、ここから先は変数fldPickerをさながらフォルダパス等の取得屋さんのように使える。
    「fldPickerさ~ん、ちょっとフォルダ選択ダイアログを表示して~!」とか、「fldPickerさ~ん、フォルダのフルパスを教えて~!」みたいな感じ。クラスを作るメリットの一つだと思う。
  • (2)がまさに「fldPickerさ~ん、ちょっとフォルダ選択ダイアログを表示して~!」。
  • (3)の「fldPicker.isCancelled」の取得は「fldPickerさ~ん、キャンセルされた?」てな感じ。
  • (4)は、さしづめ「fldPickerさ~ん、ちょっと選択されたフォルダのフルパスを教えて? rootPathに代入すっからさ!」てな感じかな。

「クラス」というものを使うと、まるでオブジェクトと会話するような感じでプログラミングできる、というメリットがある。もちろん、クラス名やフィールド名、メソッド名を適切につけた場合に限るんだろうけど。

フォルダ構成の複製

いよいよここからがメインの処理。

リスト1-3
  Dim i As Integer    '……(1)
  Dim n As Integer    '……(2)
  Dim strPath As String    '……(3)
  With ObjSh
    For i = 3 To lastRw    '……(4)
      n = 2    '……(5)
      strPath = .Cells(i, n).Value    '……(6)
      Do While .Cells(i, n).Offset(0, 1).Value <> ""    '……(7)
        strPath = strPath & "\" & _
                    .Cells(i, n).Offset(0, 1).Value    '……(8)
        n = n + 1    '……(9)
      Loop
      strPath = rootPath & "\" & strPath   '……(10)
      If Dir(strPath, vbDirectory) = "" Then   '……(11)
        MkDir strPath   '……(12)
      End If
    Next
  End With
  MsgBox "フォルダ構成の複製が終わりました。"
End Sub
リスト1-3の説明
  • (1)でループカウンタ i を宣言。一覧表を行方向に進んでいくのに使う。
  • (2)でループカウンタ n を宣言。コチラは、一覧表を列方向に進んでいくのに使う。
  • (3)は、フォルダパスを格納するのに使う変数。
  • (4)は、行方向のループ設定。3行目から最終行まで回す。
  • (5)で n の初期値を設定。今回使用するワークシートでは、A列、すなわち1列目には元のフォルダのフルパスが入っている。個々のフォルダ名は2列目以降に入っているので、n の初期値は 2 となる。
  • (6)で、まず i 行目の1つ目(B列)のフォルダ名をstrPathに格納。
  • (7)は、(7)からの5行(実質4行)のDoループの継続条件。1つ右のセルが空白になるところまで右へ右へ進んでいくイメージ。
  • (8)では、1つ右のセルに入っているフォルダ名を、アタマに「\」をつけてstrPathに連結している。
    たとえば、strPathに「A」、1つ右のセルに「B」が入っていたら、この段階でstrPathの中身が「A\B」(=Aフォルダの中にあるBフォルダ)になっているということ。
  • (9)で n をインクリメント。
  • (7)のDoループを抜けた段階で、strPathにはサブフォルダのフォルダパスが格納されているので、あとは(10)で、そのアタマに、移動先のフォルダパスと「\」を連結してやれば、サブフォルダのフルパスができる。
  • (11)で既にそのフォルダがあるかどうかを判定し、なければ(12)のMkDirステートメントで作成する。

あとは、 i が最終行番号に達するまで繰り返す。こうすることで、新たにフォルダ構成だけを指定のセルに書き込むことができる。

実行

f:id:akashi_keirin:20170328214751j:plain

ボタンをクリックしてマクロ起動。

f:id:akashi_keirin:20170328214759j:plain

フォルダを選べ、と言われるので、

f:id:akashi_keirin:20170328214808j:plain

フォルダを選択すると、

f:id:akashi_keirin:20170328214817j:plain

あっという間に完了。

f:id:akashi_keirin:20170328214824j:plain

「ち~んw」フォルダ内にフォルダができている。Bフォルダの中にC、Dフォルダがあることが分かる。Eフォルダもある。

おわりに

同じフォルダ構成を繰り返し用いる業務があるなら、ファイルはコピーせずにフォルダ構成だけを複製することができるこのマクロはなかなか便利だと思う。

@akashi_keirin on Twitter