テキスト ファイルに記載された深い階層のフォルダーを一度に作成するマクロ


コメントにて以下のご要望をいただきました。


お世話になっております。以前に “https://outlooklab.wordpress.com/2016/10/22/深い階層のフォルダーを一度に作成するマクロ/” で質問させていただきました。

前回質問させていただいた内容を応用し、フォルダー A のサブフォルダーとして作成したサブフォルダー B に対し、サブフォルダー B の配下にサブフォルダー B1 とか B2 など、並列した複数のサブフォルダーを一括作成したいと考えています。
また、同様に、フォルダー A のサブフォルダーとしてサブフォルダー C を作成し、さらに、サブフォルダー C の配下にサブフォルダー C1 とか C2 を作成したいと考えています。

何卒よろしくお願いします。


複数のフォルダーを一括作成ということとなると、そのフォルダーをまとめて指定する必要があります。
今回はテキストファイルに以下のように記述しておき、現在選択しているフォルダーの下にサブフォルダーを作成するマクロにしてみました。

A\B\B1
A\B\B2
A\C\C1
A\C\C2

テキストファイルのファイル名はマクロ冒頭の FOLDER_PATH_FILE で指定してください。

' ここをトリプルクリックでマクロ全体を選択できます。
Public Sub CreateDeepSubFolderInFile()
     On Error Resume Next
     Const FOLDER_PATH_FILE = "c:\temp\folderpath.txt"
     Dim fldRoot As Folder
     Dim fldSub As Folder
     Dim strPath As String
     Dim astrFolders As Variant
     Dim strSub As Variant
     '
     Open FOLDER_PATH_FILE For Input As #1
     While Not EOF(1)
         Line Input #1, strPath
         If strPath <> "" Then
             astrFolders = Split(strPath, "\")
             Set fldRoot = ActiveExplorer.CurrentFolder
             For Each strSub In astrFolders
                 Set fldSub = Nothing
                 Set fldSub = fldRoot.Folders(strSub)
                 If fldSub Is Nothing Then
                     Set fldSub = fldRoot.Folders.Add(strSub)
                 End If
                 Set fldRoot = fldSub
             Next
         End If
     Wend
     Close #1
End Sub

マクロの登録方法やメニューへの追加について

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

Google アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中