指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

【本日のミッション】

Excel VBAにて、指定したフォルダ内のサブフォルを全てコピーし、フォルダ構成(空のフォルダ)のみ、別に指定したフォルダに作成せよ。

ミッションの概要

去年と同じ業務やけど、フォルダ構成だけコピーしたいねん、って時ありますよね。

今回指定フォルダにするのはこちらです。

コピー元フォルダ→C:\VBA\第1階層
コピー先フォルダ→C:\VBA\第1階層_NEW

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

「コピー先フォルダ」を新規作成し、この中に「コピー元フォルダ」のサブフォルダのフォルダ構成(空のフォルダ)のみをコピーするのが今回のミッションです。

「フォルダをコピー」と言っていますが、実際はフォルダのコピー処理は行いません。

コピー元のフォルダのパスを取得して、コピー先フォルダに新しく空フォルダを作成しています。

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

各フォルダ構成は、下記の通りになっております。
■コピー元

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)


↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
■コピー先

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

ファイルの準備とプロシージャ

Excelマクロ有効ブック(.xlsm)のファイルを新規作成します。

そのファイルのシートに下記の通り、コピー元フォルダパスを指定するセル(A3)、コピー先フォルダパスを指定するセル(A6)を準備します。

コピー元フォルダパスには、コピーしたいサブフォルダの上の階層のフォルダのフルパスを入力します。

コピー先フォルダパスには、コピーしたサブフォルダを格納したいフォルダのフルパスを入力します。このフォルダはマクロ処理で新規作成されます。

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

このシートをアクティブにした状態で、Alt+F11でVsual Basic Editerを起動します。

[挿入]-[標準モジュール]で新規モジュールを作成し、下記の通りコードを記入します。

Sub 指定したフォルダ内のサブフォルダ全て空にしてコピー()  
'アクティブシートからコピー元のフォルダパスを取得(pt_m)
'アクティブシートからコピー先のフォルダパスを取得(pt_s)
'コピー先フォルダを新規作成(pt_s)
'コピー元のフォルダ(pt_m)のサブフォルダ全てを空の状態でコピー先のフォルダ(pt_s)へコピー
    '【変数】
    Dim ws As Worksheet  '処理対象シート
    Dim pt_m As String   'コピー元フォルダパス
    Dim pt_s As String   'コピー先フォルダパス
    Dim fd_len As Long   'コピー元フォルダ文字数
    
    Application.ScreenUpdating = False '画面表示の停止
    
    '■変数セット
    Set ws = ActiveSheet    '変数ws=アクティブシートをセット  'パスの最終文字が「\」でない場合「\」を付ける
    pt_m = ws.Range("A3")   '変数pt_mにセルA3のコピー元フォルダパスをセット
    pt_s = ws.Range("A6")   '変数pt_sにセルA6のコピー先フォルダパスをセット
    fd_len = Len(pt_m)      'コピー元フォルダ文字数
    
    '■コピー元フォルダ存在確認
    If Dir(pt_m, vbDirectory) = "" Then
        MsgBox "ご指定のコピー元フォルダは存在しません。"
        Exit Sub
    End If
    '■コピー先最上位フォルダ存在確認
    If Dir(pt_s, vbDirectory) <> "" Then
        MsgBox "ご指定のコピー先フォルダは既に存在します。"
        Exit Sub
    End If
    
    '■コピー先最上位フォルダ作成
    MkDir pt_s
    
    '■コピー元フォルダのサブフォルダをコピー先フォルダにコピー
    Call サブフォルダコピー(pt_m, pt_s, fd_len)  
 
    Application.ScreenUpdating = True '画面表示の再開
    
End Sub 

Sub サブフォルダコピー(pt_m As Variant, pt_s As Variant, fd_len As Long) 
    '【変数】
    Dim FSO As Object     'FileSystemObject
    Dim m_fd As Object    'メインフォルダ
    Dim s_fd As Object    'サブフォルダ
    Dim pt_sub As String  'サブフォルダパス
    
    '■変数セット
    Set FSO = CreateObject("Scripting.FileSystemObject")   'FileSystemObjectのインスタンス化
    Set m_fd = FSO.GetFolder(pt_m) 'コピー元フォルダの親フォルダ
    
    '■コピー元フォルダの親フォルダのサブフォルダを順に処理
    For Each s_fd In m_fd.SubFolders
    
        pt_sub = s_fd.Path 'サブフォルダのパス
        
        '■コピー先フォルダにサブフォルダ構造をコピー
        MkDir pt_s & Mid(pt_sub, fd_len + 1) 'サブフォルダのフルパスから、親フォルダのパスを除いた部分を抽出
        
        '■再帰処理:処理中のpt_subを親フォルダとして、サブフォルダを処理していく。
        Call サブフォルダコピー(pt_sub, pt_s, fd_len) 
    Next s_fd
    
    Set FSO = Nothing 'FSOを空っぽにする
    
End Sub  

2つのプロシージャ(Sub~End Subまで)に分かれています。

「Sub 指定したフォルダ内のサブフォルダ全て空にしてコピー() 」プロシージャのどこかにカーソルを置いてF5キーをクリックしてください。

指定したフォルダが新規作成され、その下にサブフォルダがコピーされています♪

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

フォルダ処理の順番

どんな順番で処理されているかと申しますと、この通りです。
初めに処理したフォルダのサブフォルダを処理してから、次のフォルダへ処理を移動させていますね。

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

■■■スポンサーリンク■■■

Dir関数でフォルダの存在を確認

Dir関数は、第1引数に指定したファイル・フォルダが存在する場合、パスを除いたファイル名・フォルダ名を返します。存在しない場合は長さ0の文字列 ”” 空欄 返します。

Dir(ファイル・フォルダのパス,ファイル・フォルダの属性)

Dir (“C:\VBA\第1階層” , vbDirectory)  の場合

  • ファイル・フォルダが存在する場合(ファイル名・フォルダ名を返す)→  第1階層
  • ファイル・フォルダが存在しない場合(空欄を返す)                       →  ””

第2引数に下記定数(値)を指定することで、特定の属性のオブジェクトのみを取得の対象とすることができます。

今回はフォルダが対象なので、「vbDirectory」を指定しています。

定数属性
vbNormal (既定)0標準ファイル
vbReadOnly1読み取り専用ファイル
vbHidden2隠しファイル
vbSystem4システム ファイル
vbVolume8ボリューム ラベル。この値を指定すると、すべての属性は無効になります。
vbDirectory16フォルダ
vbAlias64エイリアスファイル

※4、8はMacでは使えません。また、64はMacintoshのみ使えます。

参考:Dir関数の使い方。ファイル名やフォルダ名の取得方法。(Excel VBA)

MkDirステートメントでフォルダ作成

MkDir フォルダ名またはフォルダパス

MkDirステートメントの引数にはフォルダ名かフォルダパスかのいずれかを指定します。

フォルダ名のみを指定すると、カレントフォルダに指定した名前のフォルダが作成されます。
カレントフォルダとは、現在作業中のフォルダのことです。初期設定で指定しているフォルダや、直前にファイルを保存したフォルダになります。

MkDir "第1階層_NEW"

私の場合、ドキュメントフォルダがカレントフォルダになっているので、ドキュメントフォルダの中に「第1階層_NEW」フォルダが作られました。

フォルダパスを指定すると、指定した場所にフォルダが作られます。

MkDir "C:\VBA\第1階層_NEW"

指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

Callステートメントとは?

他のSubプロシージャやFunctionプロシージャの処理を行います。

「Call」を省略して、プロシージャの名前だけでも処理してくれるのですが、私は後から見たとき、これナニ?ってならないように「Call」を付けるようにしています。

今回、私は

Call サブフォルダコピー(pt_m, pt_s, fd_len)

みたいに、プロシージャ名の後ろに「(引数)」を指定しています。

今日は簡単に説明しちゃいますね。

「指定したフォルダ内のサブフォルダ全て空にしてコピー」プロシージャ内で、Callにセットした「pt_m」「 pt_s」「 fd_len」を引数のお弁当箱に入れて、「サブフォルダコピー」プロシージャに持っていきますよ~、みたいな感じです。

お弁当箱に入れて持ってきた引数は、持って行った先のプロシージャでも、それぞれが何者(データ型)か宣言し、そのプロシージャ内で利用します。

Sub サブフォルダコピー(pt_m As Variant, pt_s As Variant, fd_len As Long)

引数につきましては、下記ページをご参照ください。
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)

Callステートメントについては、下記ページでもう少し詳しく説明しています。
Callステートメントとは

For Eachとは?

For Each 変数 In コレクション
    ***処理***
Next 変数 

とすることで、コレクションの中にあるもの1つ目から順に変数に入れて、Nextまでの処理を行い、コレクション内にあるもの全ての処理が終わったらNext以降の処理に移ります。

今回は「s_fd」という変数をObjectとして宣言しています。Objectはここではフォルダです。

Dim m_fd As Object     'メインフォルダ
Dim s_fd As Object     'サブフォルダ

Set FSO = CreateObject("Scripting.FileSystemObject") 'FileSystemObjectのインスタンス化
Set m_fd = FSO.GetFolder(pt_m) 'コピー元フォルダの親フォルダ

For Each s_fd In m_fd.SubFolders
    Call サブフォルダコピー(pt_sub, pt_s, fd_len)
Next s_fd

コレクションの「m_fd.SubFolders」ってナゾですよね。意味合いとしては、変数m_fd(コピー元フォルダの親フォルダ)のサブフォルダ群のことです。

CreateObject(“Scripting.FileSystemObject”)とは

こちらに関しては、下記ページをご参照ください。

FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止(Excel VBA)

再帰処理とは?

こちらに関しては、下記ページをご参照ください。

再帰処理とは?指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

【参考】

指定したフォルダ内のファイル名全てを取得(Excel VBA)
変数でよく使われる「buf」「tmp」の意味
Dir関数が取得するファイルの順番
指定したフォルダ内のフォルダ名全てをGetAttrを使って「エラー53 ファイルが見つかりません。」を出さずに取得(Excel VBA)
GetAttr関数とAnd演算子でビット演算の使い方 ファイルやフォルダの属性を取得
フォルダ名だけを取得したい時に出てくる 「.」 と 「..」 とは?
指定したフォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
CreateObject(“Scripting.FileSystemObject”) を使ってサブフォルダを取得
再帰処理とは?フォルダ内とサブフォルダ内全てのファイル名を取得(Excel VBA)
指定したフォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
再帰処理とは?フォルダ内のサブフォルダのフォルダ名を全部取得(Excel VBA)
参照渡し「ByRef」と値渡し「ByVal」の違い(Excel VBA)
ファイルのフルパスからファイル名のみを取得 InStrRev関数(Excel VBA)
指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
FileSystemObjectとは?CreateObject 関数 FolderExists・GetFolderの使い方
FileSystemObject CreateObject関数を使う方法・ 参照設定を使う方法 違いを理解してエラー防止
再帰処理とは?指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得(Excel VBA)
ファイルのフルパスからファイル名のみを取得 Split関数(Excel VBA)
Callステートメントとは 引数 括弧()の使い方(Excel VBA)
指定したフォルダ内から「特定の文字を含まないファイル名」を取得(Excel VBA)
ワイルドカードとは。使い方いろいろ。(Excel)
Dir関数の使い方。ファイル名やフォルダ名の取得方法。(Excel VBA)
指定したフォルダのファイル名を取得し、そのファイル名を一括で変換(Excel VBA)
Excel起動時に「コンパイルエラー」。64ビット システムで Declareステートメントに、PtrSafe属性を設定(Excel VBA )
「ファイルを開く」ダイアログボックス から ファイル名を取得(Excel VBA)
「ファイルを開く」ダイアログボックス から 複数 ファイル名を取得(Excel VBA)
指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)
再帰処理とは?指定フォルダ内のサブフォルダ全てをフォルダ構成のみ(空フォルダ)を別フォルダにコピー(Excel VBA)

■■■スポンサーリンク■■■