トップ > 汎用コード > フォルダ構成をコピー

フォルダ構成をコピー2023.08.04

フォルダ構成をコピーするマクロです。
サンプルコードを実行すると、フォルダ選択ダイアログボックスが表示されます。ダイアログボックスでフォルダを選択し[OK]をクリックすると、選択したフォルダのフォルダ構成をコピーし複製します(ファイルはコピーされません)。
複製されたフォルダは、選択フォルダと同じフォルダに別名(フォルダ名+番号)で保存されます。
フォルダ構成コピーのコードでは、コマンドプロンプトを利用しています。以下のサイト様を参考にさせていただきました。
https://daitaideit.com/vba-copy-only-folder-structure/
https://kaede.jp/2014/05/31165935/

【サンプルコード実行動画】
動画では最初にサンプルフォルダの構成を確認しています。
その後マクロを実行し、コピーされたフォルダの構成を確認しています。
コピーされたフォルダには、元のフォルダに存在したファイルがコピーされていないことを確認できます。


【お薦め】マクロ・プロシージャを管理する無料のツール!
 Excelマクロ管理ツール

サンプルコード2023.08.04

コードの貼り付け場所

'----------------------------------------------------------------------
' フォルダ構成をコピー
'----------------------------------------------------------------------
' コマンドプロンプトを利用しフォルダの構成のみコピーするマクロです
' 新規フォルダはコピー元フォルダと同じフォルダに別名でコピーされます
'[作成日]2023/07/29 [更新日]2023/08/08
'https://excel.syogyoumujou.com/vba/copy_folder_structure.html
'[参考サイト]
'https://daitaideit.com/vba-copy-only-folder-structure/
'https://kaede.jp/2014/05/31165935/
'----------------------------------------------------------------------
Sub CopyFolderStructure()

    'コピー元フォルダの選択
    Dim strSourceFolderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "コピー元フォルダを選択してください"
        .InitialFileName = CurDir()
        If .Show Then strSourceFolderPath = .SelectedItems(1)
    End With
    If strSourceFolderPath = "" Then Exit Sub
    
    MsgBox "選択したフォルダのフォルダ構成をコピーします", vbInformation
    
    '新規フォルダ名の作成
    Dim lngCount         As Long
    Dim strNewFolderPath As String
    Do
        lngCount = lngCount + 1
    Loop Until Dir(strSourceFolderPath & "(" & lngCount & ")", vbDirectory) = ""
    strNewFolderPath = strSourceFolderPath & "(" & lngCount & ")"
    
    '新規フォルダ作成
    MkDir strNewFolderPath
    
    'コマンドプロンプト用文字列作成
    Dim strCommand(4) As String
    strCommand(0) = "xcopy"             'Windows XCOPY
    strCommand(1) = "/t"                'フォルダ構成のみをコピー(空フォルダは除く)
    strCommand(2) = "/e"                '空フォルダもコピー
    strCommand(3) = strSourceFolderPath 'コピー元フォルダ
    strCommand(4) = strNewFolderPath    'コピー先フォルダ
    
    'フォルダ構成のみコピー
    CreateObject("WScript.Shell").Run Join(strCommand, " ")

    'フォルダを開く(コピーしたフォルダの一つ上の階層)
    Shell "C:\Windows\Explorer.exe " & strNewFolderPath & "\..\", vbNormalFocus

    MsgBox "フォルダ構成をコピーしました", vbInformation
End Sub

【書籍紹介】知りたいがすぐわかる! やりたいがすぐできる!
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」(Kindle版)
ユーザーフォームを扱えると、VBAでできることが大きく広がります!
本書では、知りたいこと、やりたいことから、逆引きで学びを深められます。
140以上のサンプルファイル付き!



ページトップへ戻る

Excel 汎用コード

Copyright(C) 2009- 坂江 保 All Rights Reserved.