ファイル名が重複するときに自動ナンバリングする

ファイル名が重複しているときに自動ナンバリングしたファイル名を返すメソッド

頭の体操に作ってみた。

ExportAsFixedFormatメソッドで新規ファイルを作成したときなんかに、同一名のファイルが存在したときの対策用。

たとえば、保存先に「ち~んw.pdf」というファイルを保存しようとしたときに、既に同一名のファイルが存在した場合、「ち~んw(1).pdf」、「ち~んw(2).pdf」……といった具合に新たなファイル名にして保存するために、ナンバリングしたファイル名を返す、というふうにしたい。

コーディング

書いたコードは次の通り。

リスト1 標準モジュール
Public Function getNameWithoutDuplication( _
            ByVal fullNameWithoutFileExt As String, _
            ByVal fileExt As String) As String  '……(1)'
  Dim tmp As String  '……(2)'
  tmp = fullNameWithoutFileExt
  Dim n As Long  '……(3)'
  n = 0
  Dim fsObj As New FileSystemObject  '……(4)'
  Dim suffixStr As String
  Do While fsObj.FileExists(tmp & suffixStr & "." & fileExt)
    n = n + 1
    suffixStr = "(" & n & ")"
  Loop
  getNameWithoutDuplication = tmp & suffixStr & "." & fileExt
End Function

(1)の

Public Function getNameWithoutDuplication( _
            ByVal fullNameWithoutFileExt As String, _
            ByVal fileExt As String) As String

は引数、返り値設定。

〈拡張子を除いたファイルのフルパス〉というのは、後で見たときにわかりにくかろうと思うので、冗長な引数名にした。

拡張子を除いた新規ファイルのファイルフルパス、新規ファイルの拡張子名を受け取って、重複がある場合はナンバリングを付して拡張子も加えたファイル名、つまりはファイルのフルパスを返すメソッド。

(2)からの2行

Dim tmp As String
tmp = fullNameWithoutFileExt

は、別になくても構わないのだけれど、引数名が長すぎるので、一旦tmpで受け取る。

10行程度の短いメソッドなので、まあ許されるだろう、と。

3からの8行

Dim n As Long
n = 0
Dim fsObj As New FileSystemObject  '……(4)'
Dim suffixStr As String
Do While fsObj.FileExists(tmp & suffixStr & "." & fileExt)
  n = n + 1
  suffixStr = "(" & n & ")"
Loop

がメインの処理。

変数nは、ナンバリング用の変数。使用済みの番号があったら、ループ内でインクリメントする。

必要ないけれど、明示的に初期化しておく。

(4)の

Dim fsObj As New FileSystemObject

FileSystemObjectインスタンスを準備。ループ内でファイルの存否確認に使う。

Dir関数を使う手もあるけれど、今はFileSystemObjectの練習中だということと、FileSystemObjectを使った方がreadableになるような気がするので、積極的に使う。

事前バインディングのコードなので、参照設定を忘れずに。

ループ処理もついでに見ておこう。

ループへの突入条件は

Do While fsObj.FileExists(tmp & suffixStr & "." & fileExt)

このとおり。

readableと述べたのはまさにこのことで、「カッコ内に示したファイルが存在する間はやれ!」とそのまま読める。

Do While Dir(hogehoge) <> ""

では、直感的に何のことかわからないので、イマイチだと思うようになった。

tmp & suffixStr & "." & fileExt」がそもそも付けんと欲したファイル名なので、このファイルが存在しないならばナンバリングの必要はない。従って、ループに突入する必要などないわけだ。

ループに突入するということは、ナンバリングが必要だということなので、

n = n + 1
suffixStr = "(" & n & ")"

変数nをインクリメントさせて、カッコで括った文字列を変数suffixStrにぶちこむ。それだけ。

これを繰り返して、同一ファイル名が存在しなくなった時点でループから抜ける。

あとは、こうして得られたuniqueなファイルフルパスを返しておしまい。

使ってみる

ワークシートのA1セルを

f:id:akashi_keirin:20190323090417j:plain

こんなふうにして、次のコードで実験。

ちなみに、このワークシートのオブジェクト名を「MainSheet」に変更している。

スト2 標準モジュール
Public Sub test()
  MainSheet.Range("A1").Value = "ち~んw"
  Dim saveFolder As String
  saveFolder = ThisWorkbook.Path & "\★作成したPDF\"      '"
  Dim docFullName As String
  docFullName = getNameWithoutDuplication(saveFolder & "ち~んw", _
                                          "pdf")
  Call MainSheet.ExportAsFixedFormat( _
                   Type:=xlTypePDF, _
                   Filename:=docFullName)
End Sub

ご覧のとおり、ワークシートのA1セルに「ち~んw」と書き込んで、ブックのあるフォルダ内の「★作成したPDF」フォルダに「ち~んw.pdf」という名前のPDFファイルを出力する、というだけのコード。

実行結果

1回目

フォルダ内は、

f:id:akashi_keirin:20190323090424j:plain

こうなった。

2回目

フォルダ内は、

f:id:akashi_keirin:20190323090429j:plain

こうなった。意図したとおり。

3回目

フォルダ内は、

f:id:akashi_keirin:20190323090434j:plain

こうなった。やはり、意図したとおり。

おわりに

車輪の再発明だったら、教えてください。

参考

akashi-keirin.hatenablog.com

改良しました。