VBA を使ってフォルダをいっぱい作ろう その2

その1からの続き

VBA を使ってフォルダをいっぱい作ろう その1
おーい和休!ちょっと頼みがある。 ここに日付ごとのフォルダを作っておいてくれ。 わかりました。 えーと、今日から1年先の分まで作っ...

できましたヨ!

お!おおきにやで。ちょっとみせて。

・・・

う~ん。やっぱり年ごとにまとめてもらうとありがたいな。

どうせ直すなら、5年先まで作ってくれへんかな。

悪いけど、夜露死苦!

・・・(°□°;)まじでかー

ということで、出力する年を名前にしたフォルダをまず作り、その下へ日付を名前としたフォルダを365個×5年分(20170429~20220428)作ることになりました。

まず、作業用のフォルダを出力する場所を決めましょう。

どこでもいいのですが、今日はDドライブにあるTESTフォルダ内のoutputフォルダを出力先にします。

Dドライブがないパソコンをお使いの場合は、環境に合わせて出力先を変更してください。

Sub waq_mkfld2()

'今日から5年後までの日付を付けたフォルダを作成します。
'年ごとにフォルダを作成し、その下にその年に属する年月日のフォルダを作成します。

Dim TgTfldPath As String '出力先のパス
Dim TgTfldName As String 'フォルダの名前
Dim ymd_FR As Date  '開始年月日
Dim ymd_TO As Date  '終了年月日
Dim Nendo As String '出力するフォルダの年を代入します

TgTfldPath = "D:\TEST"

'DドライブにTESTフォルダがあるかどうかをチェック
'TESTフォルダがあればフォルダへのパスが返ってくる→次の処理へ進む
' "" が返ってくれば、TESTフォルダは存在しない→DドライブにTESTフォルダを作成する。
If Dir(TgTfldPath, vbDirectory) = "" Then
'同名のフォルダが存在しないとき
    
    MkDir (TgTfldPath) 'フォルダを作成します。
End If


'出力先をDドライブにあるTESTフォルダ内のoutputフォルダとする

TgTfldName = "output" '変数にフォルダ名をセット

TgTfldPath = "D:\TEST" & "\" & TgTfldName   '変数に出力先をセット

'出力先に同名のフォルダがあるかどうかをチェック
'同名のフォルダがあればフォルダへのパスが返ってくる→出力できないため処理中止とする。
' "" が返ってくれば、同名のフォルダは存在しない→出力可能であるため、
'DドライブにあるTESTフォルダ内にoutputフォルダを作成する。

If Dir(TgTfldPath, vbDirectory) = "" Then
'同名のフォルダが存在しないとき
    
    MkDir (TgTfldPath) 'フォルダを作成します。
Else
'同名のフォルダが存在するとき

    MsgBox "出力先に同名のフォルダがあります。処理を中止します。", vbCritical
    Exit Sub 'コードの実行を中止します。
End If

'DドライブにあるTESTフォルダ内のoutputフォルダの下に 年 のフォルダを作成し、
'年 のフォルダへ連番のフォルダを作成します。

'開始年月日に今日の日付をセットします。
ymd_FR = Date

'終了年月日に5年後の日付をセットします。
ymd_TO = DateAdd("m", 60, Date)

'変数 Nendo に 初期値をセットします。初期値はフォルダ名として扱える文字列であれば、何でもOKです。
'今日は、0 をセットします。
Nendo = "0"

Do

    '変数 Nendo にセットされた 年 と出力される日付を付けたフォルダが属する年が異なっている場合、
    'DドライブにあるTESTフォルダ内のoutputフォルダの下に 年 のフォルダを作成します。
    
    If Nendo <> Format(ymd_FR, "yyyy") Then
    
        Nendo = Format(ymd_FR, "yyyy") '変数 Nendo に 変数 ymd_FR が属する年をセットします。
        MkDir (TgTfldPath & "" & Nendo)
    End If
    
    
    MkDir (TgTfldPath & "" & Nendo & "" & Format(ymd_FR, "yyyymmdd")) 'フォルダを作成します
    'TgTfldPathには出力先(DドライブにあるTESTフォルダ内のoutputフォルダ)が代入されています。
    'さらに & を用いてフォルダ名を連結します。
    'Format(ymd_FR, "yyyymmdd")) により、20170428 という西暦8ケタの表示に変換します。
    
    ymd_FR = ymd_FR + 1  '1日加算します

Loop Until ymd_FR = ymd_TO  ' 変数 ymd_FRと変数 ymd_TO の値が同じになるまで処理をループさせます。

End Sub

以上のコードを標準モジュールに記述し、実行してみてください。

 

DドライブのTESTフォルダです。

outputフォルダがありますね。これも開けてみましょう。

 

年ごとのフォルダができあがっています。

2017年フォルダを開けました。20170429から20171231まで247個のフォルダができあがっています。

 

2018年フォルダを開けました。20180101から20181231まで365個のフォルダができあがっています。

 

2022年フォルダを開けました。20220101から20220428まで118個のフォルダができあがっています。

成功です!(b^ー°)

コメントをどうぞ!