保存するファイル名に連番を付けて保存

'==============================
' 使用例 (テスト用マクロ)
'==============================
Sub 使用例()
    Dim wb As Workbook  ' 新規ワークブック用の変数
    
    ' 新しいワークブックを作成
    Set wb = Workbooks.Add
    
    ' 指定したファイルパスに、重複を避けて保存
    Call SaveNewWorkbookWithUniqueNameFSO("C:\TEMP\test.xlsx", wb)
End Sub


'************************************
'* 保存するファイル名がすでに存在するかどうかをチェックし、存在する場合は(2),(3)などの番号を付加して保存します
'* fileFullPath：ファイルフルパス
'* wb：保存するブック
Sub SaveNewWorkbookWithUniqueNameFSO(ByVal fileFullPath As String, ByVal wb As Workbook)
    Dim savePath As String  ' 最終的に保存するパス
    
    ' 既存のファイル名をチェックし、一意のファイル名を取得
    savePath = SaveNewFileNameWithUniqueNameFSO(fileFullPath)
    
    ' 取得したファイル名でワークブックを保存 (Excel 形式)
    wb.SaveAs fileName:=savePath, FileFormat:=xlOpenXMLWorkbook
   
    ' 保存後にワークブックを閉じる（変更を保存しない）
    wb.Close SaveChanges:=False
End Sub


'************************************
'* 指定したファイル名が既に存在する場合、(2), (3) などの番号を付加して一意のファイル名を返す
'*
'* fileFullPath：ファイルのフルパス (例: "C:\TEMP\MyNewWorkbook.xlsx")
'* 返り値：一意のファイル名 (例: "C:\TEMP\MyNewWorkbook（2）.xlsx")
Function SaveNewFileNameWithUniqueNameFSO(ByVal fileFullPath As String) As String
    Dim fso As Object                ' FileSystemObject を使用するためのオブジェクト
    Dim fileName As String           ' 拡張子を除いたファイル名 (例: "C:\TEMP\test")
    Dim fileExtension As String      ' ファイルの拡張子 (例: ".xlsx")
    Dim savePath As String           ' 実際に保存するファイルのフルパス
    Dim counter As Integer           ' 連番を付けるためのカウンター
    Dim newFileName As String        ' 変更後のファイル名

    ' FileSystemObject を作成（ファイルの存在確認などに使用）
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' ファイルの拡張子を取得（例: ".xlsx"）
    fileExtension = "." & fso.GetExtensionName(fileFullPath)

    ' フルパスから拡張子を除いた基本ファイル名を取得（例: "C:\TEMP\test"）
    fileName = Replace(fileFullPath, fileExtension, "")

    ' 初期状態では、元のファイル名のまま設定
    savePath = fileName & fileExtension

    ' 既にファイルが存在する場合、(2), (3), ... のように連番を付与して保存名を決定
    counter = 1
    Do While fso.FileExists(savePath)  ' ファイルが存在する限りループ
        counter = counter + 1  ' 連番を増やす
        newFileName = fileName & "(" & counter & ")"  ' "(2)", "(3)" のように番号を追加
        savePath = newFileName & fileExtension  ' 新しいファイル名を設定
    Loop

    ' 一意のファイル名を返す
    SaveNewFileNameWithUniqueNameFSO = savePath
    
    ' FileSystemObject の解放（メモリ管理のため）
    Set fso = Nothing
End Function