プログラミング

【PR】を含みます。

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

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

VBAでファイル名に連番を付けて重複を防ぐ方法を紹介します。VBAツール開発で頻繁に使用するため、コピペで使用できるように連番付きファイルパス作成部分を関数にまとめました。

コピペ用コード

連番付きファイルパスを作成する関数

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

VBA
Copy
  1. Public Function create_new_file_path(ByVal filePath As String) As String
  2.     Dim newFilePath As String '新ファイルパス格納用変数
  4.     If (Dir(filePath) = "") Then
  5.         '同名ファイルが存在しない場合
  6.         newFilePath = filePath
  7.     Else
  8.         '同名ファイルが存在する場合
  9.         '拡張子と拡張子を除いたファイルパス取得
  10.         Dim extensionPosition As Long
  11.         extensionPosition = InStrRev(filePath, ".")
  13.         Dim exceptExtensionFilePaht As String '拡張子を除いたファイルパス格納用変数
  14.         Dim extension As String '拡張子格納用変数
  16.         If (0 < extensionPosition) Then
  17.             extension = Right(filePath, Len(filePath) - extensionPosition)
  18.             exceptExtensionFilePaht = Left(filePath, extensionPosition - 1)
  19.         Else
  20.             extension = ""
  21.             exceptExtensionFilePaht = filePath
  22.         End If
  24.         '連番文字列を生成
  25.         Dim i As Long
  26.         i = 1
  28.         Dim num As String
  29.         num = i
  31.         '連番付きの新しいパスを生成
  32.         newFilePath = exceptExtensionFilePaht & "(" & num & ")" & "." & extension
  34.         '同名のの連番付ファイル名が存在しなくなるまでループ
  35.         Do While (Dir(newFilePath) <> "")
  36.             i = i + 1
  37.             num = i
  38.             newFilePath = exceptExtensionFilePaht & "(" & num & ")" & "." & extension
  39.         Loop
  40.     End If
  42.     create_new_file_path = newFilePath
  43. End Function

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

デスクトップに用意した「test」フォルダ内の「text.txt」ファイルをデスクトップにコピーするというシンプルなサンプルコードを用意しました。

  1. デスクトップに「test」フォルダを作成し、その中に「text.txt」ファイルを格納します。
    VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像1
  2. 下記コードを実行すると、下記画像のようにデスクトップに「text.txt」ファイルのコピーが作成されます。
    VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像2
  3. ファイル名の重複がある場合、下記画像のようにファイル名の末尾に連番が付与されます。
    VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像3 VBAでファイル名に連番を付けて重複を防ぐ方法_説明画像4
VBA
Copy
  1. Sub file_copy()
  2.     'デスクトップのパスを取得
  3.     Dim wsh As Object
  4.     Set wsh = CreateObject("WScript.Shell")
  6.     Dim desktopPath As String
  7.     desktopPath = wsh.SpecialFolders("Desktop")
  9.     'コピー対象のファイルパス
  10.     Dim copyFilePath As String
  11.     copyFilePath = desktopPath & "\test\test.txt"
  13.     '保存時のファイルパス
  14.     Dim saveFilePath As String
  15.     saveFilePath = desktopPath & "\test.txt"
  17.     'ファイル名に重複があれば連番付きファイルパスを作成
  18.     Dim newSaveFilePath As String
  19.     newSaveFilePath = create_new_file_path(saveFilePath)
  21.     'ファイルコピー
  22.     FileCopy copyFilePath, newSaveFilePath
  24.     Set wsh = Nothing
  25. End Sub
  27. Public Function create_new_file_path(ByVal filePath As String) As String
  28.     Dim newFilePath As String '新ファイルパス格納用変数
  30.     If (Dir(filePath) = "") Then
  31.         '同名ファイルが存在しない場合
  32.         newFilePath = filePath
  33.     Else
  34.         '同名ファイルが存在する場合
  35.         '拡張子と拡張子を除いたファイルパス取得
  36.         Dim extensionPosition As Long
  37.         extensionPosition = InStrRev(filePath, ".")
  39.         Dim exceptExtensionFilePaht As String '拡張子を除いたファイルパス格納用変数
  40.         Dim extension As String '拡張子格納用変数
  42.         If (0 < extensionPosition) Then
  43.             extension = Right(filePath, Len(filePath) - extensionPosition)
  44.             exceptExtensionFilePaht = Left(filePath, extensionPosition - 1)
  45.         Else
  46.             extension = ""
  47.             exceptExtensionFilePaht = filePath
  48.         End If
  50.         '連番文字列を生成
  51.         Dim i As Long
  52.         i = 1
  54.         Dim num As String
  55.         num = i
  57.         '連番付きの新しいパスを生成
  58.         newFilePath = exceptExtensionFilePaht & "(" & num & ")" & "." & extension
  60.         '同名のの連番付ファイル名が存在しなくなるまでループ
  61.         Do While (Dir(newFilePath) <> "")
  62.             i = i + 1
  63.             num = i
  64.             newFilePath = exceptExtensionFilePaht & "(" & num & ")" & "." & extension
  65.         Loop
  66.     End If
  68.     create_new_file_path = newFilePath
  69. End Function

create_new_file_path()関数の使用方法

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

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

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

引数について

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

Excel VBAで初心者を卒業したいという方におすすめの1冊

アイコン画像

もみじ

入門書レベルの内容を理解できる方におすすめの1冊で、実務で必要なスキルを学ぶことができます。

具体的には、コーディングの作法や効率的なコーディング方法、CSVやWeb上のデータとの連携方法、そしてマクロの高速化などの実務で役立つスキルを学ぶことができます。

-プログラミング
-, ,