質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.42%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

854閲覧

フォルダ内にサブフォルダ作成_VBA

jabe

総合スコア43

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2023/04/19 00:43

実現したいこと

フォルダ内にサブフォルダが作成されるVBAを作成したい。
①サブフォルダ作成ツール.xlsmからVBA実行
②テスト環境フォルダ内の各フォルダ(A0001等)の中に完了フォルダが作成
●テスト環境フォルダ構成
テスト環境:対象フォルダ
ツール一覧:VBA実行ファイル格納先
イメージ説明
●対象フォルダ構成
イメージ説明
●実行後_フォルダ中身イメージ説明

前提

・②の完了フォルダを作成する際、各フォルダ(A0001等)の中に完了フォルダがあれば作成しない。
・今回フォルダ数は3個ですが、今後100個ほど増える事を想定しております。
・フォルダ内にファイル格納ケースはあるが、フォルダは完了フォルダのみの構成となる。

発生している問題・エラーメッセージ

・サブフォルダ内に完了フォルダを作成する事が出来ていないです。
・フォルダ毎に完了フォルダを作成する事が出来ていないです。

該当のソースコード

VBA

1Sub フォルダ内にサブフォルダ作成() 2 3Const copy As String = "C:\Users\○○○\Desktop\テスト環境" 'フォルダ作成上位場所 4Dim objFso As Object 5Set objFso = CreateObject("Scripting.FileSystemObject") 6 7Dim strFolderPath As String 8 9If objFso.FolderExists(copy & "\完了") Then 10 MsgBox "フォルダ完了は存在しています" 11Else 12 strFolderPath = objFso.CreateFolder(copy & "\完了") 13 MsgBox "フォルダ完了は存在しなかったので作成しました" & vbNewLine & strFolderPath 14End If 15 16Set objFso = Nothing 17 18End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

以下のようにしてください。

VBA

1Sub フォルダ内にサブフォルダ作成() 2 3 Const copy As String = "C:\Users\○○○\Desktop\テスト環境" 'フォルダ作成上位場所 4 Dim objFso As Object 5 Dim s_flds As Object 6 Dim fld As Object 7 Dim strFolderPath As String 8 Set objFso = CreateObject("Scripting.FileSystemObject") 9 Set s_flds = objFso.getfolder(copy).subfolders 10 For Each fld In s_flds 11 strFolderPath = copy & "\" & fld.Name & "\完了" 12 If objFso.FolderExists(copy & "\" & fld.Name & "\完了") Then 13 MsgBox strFolderPath & "は存在しています" 14 Else 15 objFso.CreateFolder (copy & "\" & fld.Name & "\完了") 16 MsgBox "フォルダ完了は存在しなかったので作成しました" & vbNewLine & strFolderPath 17 End If 18 Next 19End Sub 20

投稿2023/04/19 01:12

tatsu99

総合スコア5489

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jabe

2023/04/19 03:46

迅速な対応ありがとうございます。
guest

0

ベストアンサー

SubFoldersメソッドでサブフォルダのリストを取得できますので、それに対してForループの繰り返し処理でフォルダを作成すればいいでしょう。

vba

1Sub フォルダ内にサブフォルダ作成() 2 3 Const TargetFld As String = "C:\Users\○○○\Desktop\テスト環境" 'フォルダ作成上位場所 4 Dim objFso As Object 5 Set objFso = CreateObject("Scripting.FileSystemObject") 6 7 Dim objFld As Object, strFolderPath As String 8 For Each objFld In objFso.GetFolder(TargetFld).SubFolders 9 If objFso.FolderExists(objFld.Path & "\完了") Then 10 MsgBox "フォルダ完了は存在しています" 11 Else 12 strFolderPath = objFso.CreateFolder(objFld.Path & "\完了") 13 MsgBox "フォルダ完了は存在しなかったので作成しました" & vbNewLine & strFolderPath 14 End If 15 Next 16 17 Set objFso = Nothing 18 19End Sub

投稿2023/04/19 01:10

hatena19

総合スコア33927

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jabe

2023/04/19 03:46

迅速な対応ありがとうございます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.42%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問