teratail header banner
teratail header banner
質問するログイン新規登録
VBA

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

Q&A

解決済

1回答

606閲覧

VBAでセル参照とFormat関数を使用して複数階層フォルダを作成したい

provisional

総合スコア1

VBA

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

0グッド

0クリップ

投稿2022/07/02 03:00

0

0

下記コードにてフォルダ作成をしたいと考えておりましたが、月が変わっても年月の含まれたフォルダが作成されない状況です。エラー等はは発生せず、ただ作成されずに終了します。
Aというフォルダにコードを実行するファイルと注文書2022フォルダを置いています。
例として
注文書2022→○○→○○2022.06
を作成することはできておりましたが、7月に実行しても○○2022.07フォルダが作成されません。
自分なりに調べてみると最下層しか作成されないということでしたが、最下層の作成をしているので問題ないと考えていました。
試しに○○以下を削除すると新たに○○→○○2022.07が作成されることまでは確認できました。
○○→○○2022.06が存在していると月が変わったと時に該当月のフォルダが作成されないようでした。
前月のフォルダが存在していても毎月新しいフォルダが作成されるようにするためにはどのような変更をしたらよいか教えていただけないでしょか。よろしくお願いいたします。

Sub フォルダ作成() Dim xRg As Range Dim xCell As Range Dim xRgVList As Range Set xRg = Worksheets("注文書").Range("AA11") Set xRgVList = Evaluate(xRg.Validation.Formula1) For Each xCell In xRgVList xRg = xCell.Value Dim objFso As Object Set objFso = CreateObject("Scripting.FileSystemObject") If objFso.FolderExists(ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11")) Then Else objFso.CreateFolder (ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11")) If objFso.FolderExists(ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11") & "\" & Range("AA11") & Format(Date, "yyyy.mm")) Then Else objFso.CreateFolder (ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11") & "\" & Range("AA11") & Format(Date, "yyyy.mm")) End If End If Set objFso = Nothing Next End Sub

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

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

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

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

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

guest

回答1

0

ベストアンサー

2回目以降はElseに入らないからでは。

If Not objFso.FolderExists(ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11")) Then objFso.CreateFolder (ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11")) End If If Not objFso.FolderExists(ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11") & "\" & Range("AA11") & Format(Date, "yyyy.mm")) Then objFso.CreateFolder (ThisWorkbook.Path & "\注文書2022" & "\" & Range("AA11") & "\" & Range("AA11") & Format(Date, "yyyy.mm")) End If

<追記>
少し書き換えてみました。

Dim wPath, wSubPath wPath = ThisWorkbook.Path & "\注文書2022" & "\" & xRg.Value wSubPath = wPath & "\" & xRg.Value & Format(Date, "yyyy.mm") If Not objFso.FolderExists(wPath) Then objFso.CreateFolder wPath If Not objFso.FolderExists(wSubPath) Then objFso.CreateFolder wSubPath

投稿2022/07/02 03:25

編集2022/07/02 03:30
jinoji

総合スコア4592

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

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

provisional

2022/07/02 04:10

さっそくご回答ご教示くださりありがとうございます。 そもそもElseに入らないからエラーにもならなかったんですね。ご教示いただいたコードで希望通りの動きになりました。簡潔にもしていただきありがとうございます。 繰り返し読み解き、勉強したいと思います。次はファイル移動をしたいと考えていますが、また悪戦苦闘しそうです。 ありがとうございます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.30%

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

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

質問する

関連した質問