【ExcelVBA】重複しないよう連番付きでフォルダを作成する

フォルダを作成してそこへファイルを出力するマクロを作るとき、
「必ず新しい(＝空の)フォルダが必要」になることがあります。

その時は、既定のフォルダ名を指定しつつ、
「もし同名のフォルダが存在した場合は連番を付ける」
ルールにすることが多いと思います。

例えばこのようなフォルダ名ですね。

重複しないよう連番付きにしたフォルダ

基本は「yyyymmdd」をフォルダ名としつつ、
日に複数回実行したときは連番を付けて重複を回避しています。

このように「同名フォルダが存在した場合は連番を付けてフォルダを新規作成」するときは、以下のコードを実行します。

Sub 指定の親フォルダ内にyyyymmddフォルダを作成する()
    
    Dim Path親フォルダ As String: Path親フォルダ = "C:\Users\wfsp\Desktop\テスト"
    Dim 作成フォルダ名 As String: 作成フォルダ名 = Format(Date, "yyyymmdd")
    
    ' 作成するフォルダパス
    Dim path作成フォルダ As String
    path作成フォルダ = Path親フォルダ & "\" & 作成フォルダ名
    
    ' このフォルダが既にある場合
    If Dir(path作成フォルダ, vbDirectory) <> "" Then
        
        ' まだフォルダがない番号まで連番を進めてフォルダ名に連結
        Dim i As Long: i = 2
        Do While Dir(path作成フォルダ & "-" & i, vbDirectory) <> ""
            i = i + 1
        Loop
        path作成フォルダ = path作成フォルダ & "-" & i
        
    End If
    
    ' フォルダを作成
    MkDir path作成フォルダ

End Sub

処理の流れは単純で、
「フォルダ名 & i」が存在しないフォルダ名になるまでiを増やしていくコードです。

サンプルは「-i」とハイフンでつないでいますが、
ここを(i)や_iなどに変えれば連番のつけ方を変更できます。

このコードは「基本はyyyymmddでもし被ったら2から付番」という処理ですが、
「最初から連番を付けてyyyymmdd-1」で作成する場合は以下のように書き換えます。

Sub 指定の親フォルダ内にyyyymmddフォルダを作成する()
    
    Dim Path親フォルダ As String: Path親フォルダ = "C:\Users\wfsp\Desktop\テスト"
    Dim 作成フォルダ名 As String: 作成フォルダ名 = Format(Date, "yyyymmdd")
    
    ' 作成するフォルダパス
    Dim path作成フォルダ As String
    path作成フォルダ = Path親フォルダ & "\" & 作成フォルダ名
        
    ' まだフォルダがない番号まで連番を進めてフォルダ名に連結
    Dim i As Long: i = 1
    Do While Dir(path作成フォルダ & "-" & i, vbDirectory) <> ""
        i = i + 1
    Loop
    path作成フォルダ = path作成フォルダ & "-" & i
        
    ' フォルダを作成
    MkDir path作成フォルダ

End Sub

　
コードを見比べるっとわかりますが、
i を増やしていくループに入る条件だった

If Dir(path作成フォルダ, vbDirectory) <> "" Then

を消して、

代わりにi を増やすループの初期値を

Dim i As Long: i = 1 ' ←これを2から1に変更
Do While Dir(path作成フォルダ & "-" & i, vbDirectory) <> ""

としたコードです。

汎用関数化

上記のコードは単純ですがそこそこ長いコードなので、
この処理をよく書く人は汎用関数にしておくと便利です。

汎用関数化した場合の、実行コードと関数コードは以下のようになります。

' 実行例
Sub Thisworkbookを新規フォルダに保存する()

    Dim path保存フォルダ As String
    path保存フォルダ = 連番を付与して新規フォルダを作成する _
        ("C:\Users\wfsp\Desktop\テスト", Format(Date, "yyyymmdd"))
    
    ThisWorkbook.SaveAs path保存フォルダ & "\～～～.xlm"

End Sub


' 汎用関数
Function 連番を付与して新規フォルダを作成する(Path親フォルダ As String , 作成フォルダ名 As String _
    , Optional is第1フォルダにも付番する As Boolean = False) As String
    
    Dim path作成フォルダ As String
    path作成フォルダ = Path親フォルダ & "\" & 作成フォルダ名
        
    ' まだフォルダがない番号まで連番を進める
    Dim i As Long: i = 1
    Do While Dir(path作成フォルダ & "-" & i, vbDirectory) <> ""
        i = i + 1
    Loop
    
    ' 決まった番号を付番（オプションによっては1も付番）
    If i >= 2 Or is第1フォルダにも付番する Then
        path作成フォルダ = path作成フォルダ & "-" & i
    End If
        
    ' フォルダを作成
    MkDir path作成フォルダ

    ' 作成したフォルダパスを返す
    連番を付与して新規フォルダを作成する = path作成フォルダ

End Function

実行例の通り、フォルダの作成が1行で済むようになっていますね。

関数の中身も冒頭のコードとほぼ同じですので、
処理の内容はわかりやすいと思います。

関数の最後に重要な追加コードがありますが、
こういったコードは「結果を返り値として返す」のが重要です。

ただSubプロシージャで作っただけですと、
新規フォルダは作れても、それが何番のフォルダかわかりませんからね。

あとは細かい点として、第1ファイルにも「-1」を付けるかどうかを、
Booleanの引数で設定できるようになっています。

Optionalキーワードを使って「省略可能」にしていますので、
何も指定しない場合は「-1をつけない」版として動きます。

' 第1フォルダを「20221219」にしたいとき
path保存フォルダ = 連番を付与して新規フォルダを作成する _
    ("C:\Users\wfsp\Desktop\テスト", Format(Date, "yyyymmdd"))

' 第1フォルダを「20221219-1」にしたいとき
path保存フォルダ = 連番を付与して新規フォルダを作成する _
    ("C:\Users\wfsp\Desktop\テスト", Format(Date, "yyyymmdd"), True)

こういう微妙な挙動の違いをBooleanで切り替え可能にすると、
関数の使い勝手が良くなるので覚えておきましょう。

このように、よく使うコードは汎用関数にしておくと便利です。

汎用関数の作り方、使い方に興味がありましたら、
ぜひこちらの記事で勉強してみてください。

和風スパゲティのレシピ

日本語でコーディングするExcelVBA

重複しないよう連番付きでフォルダを作成する

汎用関数化