【PR】を含みます。

プログラミング

【VBA】ファイル名に連番を付けて重複を防ぐ方法

VBA ファイル名に連番を付けて重複を防ぐ方法

VBAでファイルを保存する際、同名ファイルが存在すると上書きされてしまうリスクがあります。

本記事では、ファイル名の重複を自動で回避し、連番（例：test(1).txt）の付いたファイルパスを生成する関数を紹介します。

Excel VBAやAccess VBAなど幅広く使えるコピペ用コード付きです。

【VBAで連番ファイル名を作成】ファイル名の重複を防ぐ関数

VBAでファイルを保存する際、同じ名前のファイルがある場合、重複しないように連番付きのファイル名を作成することができます。

【コピペOK】連番付きファイルパスを作成する関数(create_new_file_path)

以下の関数は「Excel VBA」だけではなく、「Access VBA」などでも使用可能です。

VBA
Copy
Public Function create_new_file_path(ByVal filePath As String) As String
    Dim newFilePath As String
    ' 指定したパスにファイルが存在しなければ、そのまま返す
    If Dir(filePath) = "" Then
        create_new_file_path = filePath
        Exit Function
    End If
    ' ファイルの拡張子位置を取得
    Dim extensionPosition As Long
    extensionPosition = InStrRev(filePath, ".")
    ' 拡張子を分ける
    Dim exceptExtensionFilePath As String
    Dim extension As String
    If extensionPosition > 0 Then
        extension = Mid(filePath, extensionPosition)
        exceptExtensionFilePath = Left(filePath, extensionPosition - 1)
    Else
        extension = ""
        exceptExtensionFilePath = filePath
    End If
    ' ファイル名が重複しないように連番を作成
    Dim i As Long: i = 1
    Do
        newFilePath = exceptExtensionFilePath & "(" & i & ")" & extension
        i = i + 1
    Loop While Dir(newFilePath) <> "" ' ファイル名が存在すれば繰り返す
    create_new_file_path = newFilePath
End Function

create_new_file_path関数の使い方

ファイル名に「(1)」「(2)」のような連番が自動的に付与されるため、既存ファイルを上書きしてしまう心配がありません。

第一引数のfilePathに保存時のファイルパスを指定することで使用可能です。

ファイルパスに重複がなければ、そのままのファイルパスを返します。

ファイルパスが重複している場合、ファイル名の末尾に連番を付与したファイルパスを返します。

引数について

  1. filePath (必須)
    保存時のファイルパスを指定します。

【サンプルコード】連番付きファイルパスを作成しFileCopyステートメントでコピーファイルを作成

デスクトップに用意した「test」フォルダ内の「test.txt」ファイルをデスクトップにコピーするVBAコードを作成しました。

  1. デスクトップに「test」フォルダを作成し、その中に「test.txt」ファイルを格納します。
    VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像1
  2. 下記コードを実行すると、下記画像のようにデスクトップに「test.txt」ファイルのコピーが作成されます。
    VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像2
  3. ファイル名の重複がある場合、下記画像のようにファイル名の末尾に連番が付与されます。
    VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像3 VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像4
VBA
Copy
Sub file_copy()
    'デスクトップのパスを取得
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    Dim desktopPath As String
    desktopPath = wsh.SpecialFdivders("Desktop")
    'コピー対象のファイルパス
    Dim copyFilePath As String
    copyFilePath = desktopPath & "\test\test.txt"
    '保存時のファイルパス
    Dim saveFilePath As String
    saveFilePath = desktopPath & "\test.txt"
    'ファイル名に重複があれば連番付きファイルパスを作成
    Dim newSaveFilePath As String
    newSaveFilePath = create_new_file_path(saveFilePath)
    'ファイルコピー
    FileCopy copyFilePath, newSaveFilePath
    Set wsh = Nothing
End Sub
Public Function create_new_file_path(ByVal filePath As String) As String
    Dim newFilePath As String
    ' 指定したパスにファイルが存在しなければ、そのまま返す
    If Dir(filePath) = "" Then
        create_new_file_path = filePath
        Exit Function
    End If
    ' ファイルの拡張子位置を取得
    Dim extensionPosition As Long
    extensionPosition = InStrRev(filePath, ".")
    ' 拡張子を分ける
    Dim exceptExtensionFilePath As String
    Dim extension As String
    If extensionPosition > 0 Then
        extension = Mid(filePath, extensionPosition)
        exceptExtensionFilePath = Left(filePath, extensionPosition - 1)
    Else
        extension = ""
        exceptExtensionFilePath = filePath
    End If
    ' ファイル名が重複しないように連番を作成
    Dim i As Long: i = 1
    Do
        newFilePath = exceptExtensionFilePath & "(" & i & ")" & extension
        i = i + 1
    Loop While Dir(newFilePath) <> "" ' ファイル名が存在すれば繰り返す
    create_new_file_path = newFilePath
End Function

-プログラミング
-, ,