ファイル名が重複するときに自動ナンバリングする - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

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

頭の体操に作ってみた。

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

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

コーディング

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

リスト１　標準モジュール

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)からの２行

Dim tmp As String
tmp = fullNameWithoutFileExt

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

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

３からの８行

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なファイルフルパスを返しておしまい。

使ってみる

ワークシートのＡ１セルを

f:id:akashi_keirin:20190323090417j:plain

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

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

リスト２　標準モジュール

Public Sub test()
  MainSheet.Range("A1").Value = "ち～んｗ"
  Dim saveFolder As String
  saveFolder = ThisWorkbook.Path & "\★作成したPDF\"      '"
  Dim docFullName As String
  docFullName = getNameWithoutDuplication(saveFolder & "ち～んｗ", _
                                          "pdf")
  Call MainSheet.ExportAsFixedFormat( _
                   Type:=xlTypePDF, _
                   Filename:=docFullName)
End Sub

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