【ExcelVBA】重複しないようファイル名に連番を付与する関数

ブックを保存したり、ファイルをコピー・移動する際に、
既存ファイルを上書きしたくないときは別のファイル名にする必要があります。

既存ファイルがあったら(2)など連番をつけるのが手っ取り早いのですが、
このコードが簡単な割には書くのが面倒なコードなんですよね。

こういった「重要じゃないくせに書くのが億劫なコード」は、
汎用関数を作ってもう書かなくてよくしてしまいましょう。

その関数がこちらです。

Public FSO As New FileSystemObject

Function Get重複がないよう付番したファイル名(元ファイル名 As String, フォルダパス As String) As String
    
    Dim ベース名 As String: ベース名 = FSO.GetBaseName(元ファイル名)
    Dim 拡張子 As String: 拡張子 = FSO.GetExtensionName(元ファイル名)
    
    Dim 決定ファイル名 As String: 決定ファイル名 = 元ファイル名
    
    If FSO.FileExists(フォルダパス & "\" & 決定ファイル名) Then
        Dim i As Long: i = 2
        Do
            決定ファイル名 = ベース名 & " (" & i & ")." & 拡張子
            If FSO.FileExists(フォルダパス & "\" & 決定ファイル名) = False Then Exit Do
            i = i + 1
        Loop
    End If
    
    Get重複がないよう付番したファイル名 = 決定ファイル名
    
End Function

' 実行例
' ブックを新規保存
生成ブック.SaveAs 保存フォルダパス & "\" _
    & Get重複がないよう付番したファイル名("Book1.xlsx", 保存フォルダパス)

' 移動先を上書きしないようにPDFファイルを移動
PDFファイル.Move 移動先フォルダパス & "\" _
    & Get重複がないよう付番したファイル名("資料.pdf", 移動先フォルダパス)

　
素直なコードですので詳細は割愛します。

ファイルが存在しなくなるまでiを増やし、
ファイルベース名 & (i) & 拡張子を取得する

というコードですね。

Windowsをまねて「 (2)」を付けていますが、
-2-なり_2なり好きな形にカスタマイズして使ってください。

この関数を一度作っておけば、実行例の通り、
めんどくさいDo文をもう二度と書かなくてよくなります。

重要じゃないくせに書くのが億劫なコードは汎用関数に

というのはとても大事なことなので覚えておきましょう。

なお、ついでですが、

Public FSO As New FileSystemObject

このようにFSOをPublic変数で宣言してしまえば、
すべてのプロシージャでFSOを使いまわせます。

せっかく汎用関数を使うのであれば、
メインコードの変数宣言もなくせるこの手法も使いましょう。

詳しくはこちらをどうぞ
www.limecode.jp

そもそもFileSystemObjectが初見という方はこちらをどうぞ
www.limecode.jp

また、再掲する実行例を見るとわかる通り、
実際に使うとフォルダパスが2度出てくることがかなり多いです。

' 実行例
' ブックを新規保存
生成ブック.SaveAs 保存フォルダパス & "\" _
    & Get重複がないよう付番したファイル名("Book1.xlsx", 保存フォルダパス)

' 移動先を上書きしないようにPDFファイルを移動
PDFファイル.Move 移動先フォルダパス & "\" _
    & Get重複がないよう付番したファイル名("資料.pdf", 移動先フォルダパス)

' ↑ 両コードとも「フォルダパス」が二度出てくる

　
どうせ使うときはパスならばと、返り値をパスにするのもおすすめです。

Function GetPath重複がないようファイル名に付番(元ファイル名 As String, フォルダパス As String) As String
    
    Dim ベース名 As String: ベース名 = FSO.GetBaseName(元ファイル名)
    Dim 拡張子 As String: 拡張子 = FSO.GetExtensionName(元ファイル名)
    
    Dim 決定ファイルパス As String: 決定ファイルパス = フォルダパス & "\" & 元ファイル名
    
    If FSO.FileExists(決定ファイルパス) Then
        Dim i As Long: i = 2
        Do
            決定ファイルパス = フォルダパス & "\" & ベース名 & " (" & i & ")." & 拡張子
            If FSO.FileExists(決定ファイルパス) = False Then Exit Do
            i = i + 1
        Loop
    End If
    
    GetPath重複がないようファイル名に付番 = 決定ファイルパス
    
End Function

' 実行例
' ブックを新規保存
生成ブック.SaveAs GetPath重複がないよう付番したファイル名("Book1.xlsx", 保存フォルダパス)

' 移動先を上書きしないようにPDFファイルを移動
PDFファイル.Move GetPath重複がないよう付番したファイル名("資料.pdf", 保存フォルダパス)

記事としてわかりやすくなるようファイル名バージョンを先に紹介しましたが、
利便性はこちらが勝ると思います。

お好きな方をお持ち帰りいただくか、
ファイル名Verを使ってファイルパスVerを作るのもいいと思います。

Function GetPath重複がないようファイル名に付番(元ファイル名 As String, フォルダパス As String) As String
    GetPath重複がないようファイル名に付番 = フォルダパス & "\" _
        & Get重複がないよう付番したファイル名(元ファイル名, フォルダパス)
End Function

好みの方法で実装してみてください。

汎用関数の作り方についてはこちらをどうぞ。
www.limecode.jp

和風スパゲティのレシピ

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

重複しないようファイル名に連番を付与する関数