フォルダ構成を別のフォルダにコピーするマクロ(3) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

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

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

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

処理の下準備

リスト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)は、Ａ３セルが空白かどうかで条件分岐。Ａ３セルに何も入っていなければ、そもそもフォルダ構成が取得できていないということなので、メッセージを表示して処理を終える。
(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)は、行方向のループ設定。３行目から最終行まで回す。
(5)で n の初期値を設定。今回使用するワークシートでは、Ａ列、すなわち１列目には元のフォルダのフルパスが入っている。個々のフォルダ名は２列目以降に入っているので、n の初期値は 2 となる。
(6)で、まず i 行目の１つ目（Ｂ列）のフォルダ名をstrPathに格納。
(7)は、(7)からの５行（実質４行）のDoループの継続条件。１つ右のセルが空白になるところまで右へ右へ進んでいくイメージ。
(8)では、１つ右のセルに入っているフォルダ名を、アタマに「\」をつけてstrPathに連結している。
たとえば、strPathに「A」、１つ右のセルに「B」が入っていたら、この段階でstrPathの中身が「A\B」（＝Aフォルダの中にあるBフォルダ）になっているということ。
(9)で n をインクリメント。
(7)のDoループを抜けた段階で、strPathにはサブフォルダのフォルダパスが格納されているので、あとは(10)で、そのアタマに、移動先のフォルダパスと「\」を連結してやれば、サブフォルダのフルパスができる。
(11)で既にそのフォルダがあるかどうかを判定し、なければ(12)のMkDirステートメントで作成する。