【ExcelVBA】フォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーするには

この記事では、フォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーする方法についてご説明します。

【動画】フォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーする実際の動き

本題に入る前に、まずは次の動画をご覧ください。


コピー元のフォルダから、配下全てのフォルダをフォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーしています。

ただし、コピーと言っても実は「新規で同じフォルダ名を作成」しています。同じ構成でフォルダを作成するので、作成元と見た目が同じになるのでコピーと言う表現を使っています。

「新規で同じフォルダ名を作成」するにはMkDirステートメントを使ってフォルダを作成していますが、本記事ではコピーと言う表現を使って説明します。

マクロ作成の流れ

STEP.1
配下全てのフォルダをコピーするトップのフォルダからフォルダオブジェクトを取得する
配下全てのフォルダをコピーするトップのフォルダからフォルダオブジェクトを取得します。
STEP.2
STEP.1のフォルダオブジェクトを対象に、トップのフォルダ配下に存在するフォルダ全てを同じ構成で作成する
STEP.1のフォルダオブジェクトを対象に、トップのフォルダ配下に存在するフォルダ全てを同じ構成で作成します。
存在するフォルダ全てをコピー(作成)するには、STEP.1のフォルダオブジェクトに対してSubFoldersプロパティを使いフォルダ配下のフォルダを全て取得してMkDirステートメントで作成します。
また、フォルダ配下の全てのフォルダを特定するには、再帰処理を使って繰り返し(For Eachステートメントを使用)行います。
再帰処理については「注目すべきコード」の説明の中で触れていますのでそちらをご覧ください。

Excelファイルの例

コピー元フォルダ名を入力するセルには「folderCopyFrom」と、コピー先フォルダ名を入力するセルには「folderCopyTo」という名前を付けています。

コードの例

Excelのマクロのコード(例)

Option Explicit

Private Sub btn_copyFolderOnly_Click()
    
    Dim folderCopyFrom  As String       'コピー元のフォルダパス
    Dim folderCopyTo    As String       'コピー先のフォルダパス
        
    'コピー元のフォルダパスを取得する
    folderCopyFrom = Sheets("top").Range("folderCopyFrom").Value
    
    'コピー先のフォルダパスを取得する
    folderCopyTo = Sheets("top").Range("folderCopyTo").Value
        
    'フォルダ名・ファイル名を取得する
    Call copyFolderOnly(folderCopyFrom, folderCopyTo)
    
    MsgBox "完了"

End Sub
                     
Sub copyFolderOnly(folderCopyFrom As String, folderCopyTo As String)
    
    Dim mflder          As Object               '主フォルダ
    Dim sflder          As Object               'サブフォルダ
    Dim fso             As FileSystemObject     'FileSystemObjectのインスタンス用変数
    
    'FileSystemObjectのインスタンスを生成する
    Set fso = New FileSystemObject
    
    If fso.FolderExists(folderCopyFrom) = False Then
    
        '指定したフォルダが存在しない場合
    
        MsgBox "存在するフォルダを指定してください"
        
        '処理を終了する
        End
    
    End If
    
    '指定したフォルダのパスからフォルダオブジェクトを取得する
    Set mflder = fso.GetFolder(folderCopyFrom)
    
    'パスのサブフォルダを対象にループする
    For Each sflder In mflder.SubFolders
    
        'フォルダを作成する
        MkDir folderCopyTo & "\" & Replace(sflder.Path, Sheets("top").Range("folderCopyFrom").Value & "\", "")
        
        '自プロシージャを再帰呼び出しする
        Call copyFolderOnly(sflder.Path, folderCopyTo)

        DoEvents
    
    Next sflder
    
End Sub

コードの解説

注目すべきコード

見て頂きたいのは42行目から55行目です。

    '指定したフォルダのパスからフォルダオブジェクトを取得する
    Set mflder = fso.GetFolder(folderCopyFrom)

    'パスのサブフォルダを対象にループする
    For Each sflder In mflder.SubFolders
    
        'フォルダを作成する
        MkDir folderCopyTo & "\" & Replace(sflder.Path, Sheets("top").Range("folderCopyFrom").Value & "\", "")
        
        '自プロシージャを再帰呼び出しする
        Call copyFolderOnly(sflder.Path, folderCopyTo)
 
        DoEvents
    
    Next sflder

42行目では、配下全てのフォルダをコピーするトップのフォルダから「まずは」フォルダオブジェクトを取得しています。

なお、トップのフォルダから配下のフォルダ内を一つ特定したら48行目で、その特定したフォルダ名と同じ名前のフォルダをMkDirステートメントでコピー先に作成します。

MkDirステートメントについて

MkDirステートメントを実行すると、新規でフォルダが作成されます。

MkDirステートメントの引数には、作成したいフォルダをフルパスで指定します。

【コードの例】

MkDir "C:\work\test"

上記のコードは、「C:\work」の配下に「test」というフォルダを新規で作成するコードです。

上記のコードを実行すると下の画像のとおりに「test」というフォルダが作成されます。


次に51行目で自プロシージャ(copyFolderOnly)内で自プロシージャ(copyFolderOnly)を呼び出します。

自プロシージャ(copyFolderOnly)
Sub copyFolderOnly(folderCopyFrom As String, folderCopyTo As String)

なぜ再度自プロシージャ(copyFolderOnly)を呼び出すのかというと、階層を一つずつ掘り下げて、掘り下げた先の配下にフォルダがないかを探しに行きたいからです。

例えば、「C:¥work¥work1¥work2¥work3」というフォルダが存在していて、「C:¥work」配下のフォルダ全てを、フォルダ構成そのままに別のフォルダにコピーしたいとします。

以上のフォルダの場合、欲しいフォルダは「work1」「work2」「work3」のフォルダです。

どのようにフォルダ構成そのままに別のフォルダにコピーするのか、その処理の流れとしては次のイメージです。

STEP.1
まずは「work1」のフォルダを特定して指定の別フォルダにコピーします。
STEP.2
「work1」のフォルダが特定できたら、次に「work1」のフォルダの1つ下の階層を探しに行きます。
STEP.3
1つ下の階層を探しに行き、「work2」のフォルダを特定します。
STEP.4
「work2」のフォルダが特定できたら、STEP.1で別フォルダに作成した「work1」のフォルダ配下に「work2」のフォルダをコピーします。
STEP.5
次に「work2」のフォルダの1つ下の階層を探しに行きます。
STEP.6
「work2」のフォルダが特定できたら、次に「work2」のフォルダの1つ下の階層を探しに行きます。
STEP.7
1つ下の階層を探しに行き、「work3」のフォルダを特定します。
STEP.8
「work3」のフォルダが特定できたら、STEP.4で別フォルダに作成した「work2」のフォルダ配下に「work3」のフォルダをコピーします。

以上のように階層を一つ掘り下げてフォルダが見つかったら、その見つかったフォルダから続けて階層を一つ掘り下げてフォルダがないかを探しに行く…この「階層を一つ掘り下げてフォルダがないか探す」処理を繰り返すために、再度自プロシージャ(copyFolderOnly)を呼び出すというわけです。

この、プロシージャ(copyFolderOnly)内で処理が行われている途中にもかかわらず自プロシージャ(copyFolderOnly)を呼び出す処理のことを「再帰処理」と呼びます。

自プロシージャ(copyFolderOnly)は呼び出されたら、自プロシージャ(copyFolderOnly)の頭から再度処理が始まります。

再度同じプロシージャが呼び出される(再帰処理が行われる)と再度42行目で、特定したフォルダをGetFolderの引数に指定してフォルダオブジェクトを取得します。

特定したフォルダからフォルダオブジェクトを取得したら、特定したフォルダに対して再度「階層を一つ掘り下げてフォルダがないか探す」処理を繰り返します。

全てのフォルダが特定できて指定の別フォルダに対してフォルダ構成そのままにコピーできたらマクロの処理は完了です。

動作確認

マクロ実行前

コピー元フォルダのフォルダとコピー先のフォルダを次のように指定してマクロを実行します。

コピー元フォルダ
C:\Program Files (x86)\Microsoft SQL Server

コピー先フォルダ
C:\work\10_勉強\10_VBA関連\0114\to

マクロ実行後

マクロを実行すると、フォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーされます。

コピー元フォルダ

コピー先フォルダ

【注意】参照設定が必要です

一つ注意点があるのですが、先ほどのコードを動かすには参照設定が必要です。

参照設定の一覧(下の画像を参考)から次の項目(ライブラリ)にチェックを付けて「OK」ボタンをクリックします。

  1. Windows Script Host Object Model(wshom.ocx)

なぜ必要かというと、Excelのマクロのコードの28行目の「FileSystemObject」というオブジェクトが「wshom.ocx」というファイルを参照するからです。

    'FileSystemObjectのインスタンスを生成する
    Set fso = New FileSystemObject

この参照設定をしないと下の画像のエラーが出ますので必ず行う必要があります。

ここでは「wshom.ocx」とは何者かについては記事の本題から逸れてしまうので詳細は割愛しますが、マクロで「wshom.ocx」というオブジェクトを使う場合は参照設定しないと動かない、程度に思って頂ければと思います。

最後に

本記事では、フォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーする方法についてご説明しました。

「再帰処理」という手法を使うことで、フォルダ構成そのままにサブフォルダ含めて全てのフォルダだけを別フォルダにコピーすることができます。

「再帰処理」については「注目すべきコード」の説明の中で触れていますのでそちらをご覧ください。

ファイルはいらないからフォルダだけフォルダ構成そのままにフォルダをコピーしたい場合は是非参考にしてみてくださいね。

プログラミングのスキルを習得するなら

プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。

プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。

→ TechAcademyの「1週間 無料体験」はこちら