2024年（可変可能）フォルダを探して、さらに1月...12月のサブフォルダを作るVBA

’フォルダ作成ダブり処理に関わるエラートラップあり  

Sub MakeMonthFolder()

Dim myArrayMonth(12) As Variant

Dim i As Integer

Dim Filename As String

Dim myYear As Integer

Dim myPath, mySubPath, YearFolder As String

'myPath = Left(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\") - 1) & "\"

myPath = ThisWorkbook.path & "\"

YearFolder = CVar(Left(Date, 4)) + 1 '+1次年度、-1前年度

mySubPath = myPath & YearFolder & "-Excel" & "\"

 

'  Debug.Print mySubPath

 

For i = 1 To 12  

 myArrayMonth(i) = i & "月"

  If Dir(mySubPath & "\" & myArrayMonth(i), vbDirectory) = "" Then

  MkDir (mySubPath & "\" & myArrayMonth(i))

Else

' Debug.Print myPath & mySubPath & myArrayMonth(i) & ",フォルダの存在を確認しました"

Exit Sub

 End If

'

Next i

End Sub