ファイル名が重複するときに自動ナンバリングする
ファイル名が重複しているときに自動ナンバリングしたファイル名を返すメソッド
頭の体操に作ってみた。
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セルを
こんなふうにして、次のコードで実験。
ちなみに、このワークシートのオブジェクト名を「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回目
フォルダ内は、
こうなった。
2回目
フォルダ内は、
こうなった。意図したとおり。
3回目
フォルダ内は、
こうなった。やはり、意図したとおり。
おわりに
車輪の再発明だったら、教えろてください。
参考
改良しました。