【VBA】ファイル出力時に同じファイル名があった場合別名保存をする

やりたいこと

• 保存ダイアログを使って保存する。
• 保存ダイアログで指定した保存先に同じファイル名が存在した場合に、ファイル名の後ろに (1) とか付けたい。

コード

CSVファイルの場合

Sub outputCSV()
    Dim dtDate As String
    Dim fileSaveName As Variant
    Dim fileSaveName_name As String
    Dim fileSaveName_path As String
    Dim k As Integer

    '''保存ダイアログを開く
    dtDate = Format(Now, "yyyymmdd")
    fileSaveName = Application.GetSaveAsFilename( _
                    InitialFileName:=dtDate & ".csv", _
                    FileFilter:="CSVファイル(*.csv),*.csv", _
                    FilterIndex:=1, _
                    Title:="保存ファイルの指定")
    If fileSaveName = False Then Exit Sub

    '''保存しようとしたファイル名と既に同じファイル名が存在するならば、
    '''ファイル名の末尾に(i)をつける
    If Dir(fileSaveName) <> "" Then
        '保存ファイル名を取得
        fileSaveName_name = Dir(fileSaveName)
        '保存先のフォルダを取得
        fileSaveName_path = Replace(fileSaveName, fileSaveName_name, "")

        '保存ファイル名の末尾に(i)をつける
        k = 1
        Do While Dir(fileSaveName) <> ""
            fileSaveName = fileSaveName_path & Replace(fileSaveName_name, ".csv", "") & "(" & k & ")" & ".csv"
            k = k + 1
        Loop
    End If

    '''ファイルに対して処理を行う
    Open fileSaveName For Output As #1
        　処理　
    Close #1
End Sub

レビュー

保存ダイアログを開く

【参考】

同じファイル名のファイルが存在するか

【参考】

If Dir(fileSaveName) <> "" Then
End If

Dir(フルパス)でファイル名を返す。そのフルパスが存在しなければ、空を返す。
例)　C:\Desktop\hoge.txt　→　hoge.txt

フルパスをパスとファイル名に分割する

【参考】

'保存ファイル名を取得
fileSaveName_name = Dir(fileSaveName)
'保存先のフォルダを取得
fileSaveName_path = Replace(fileSaveName, fileSaveName_name, "")

末尾に(i)がついたファイル名(拡張子付)を返す

'保存ファイル名の末尾に(i)をつける
k = 1
Do While Dir(fileSaveName) <> ""
    fileSaveName = fileSaveName_path & Replace(fileSaveName_name, ".csv", "") & "(" & k & ")" & ".csv"
    k = k + 1
Loop