EXCEL VBA シートごとにPDF出力したいが、同姓同名ファイルが上書きされてほしくない

実現したいこと

EXCEL VBA 内で**【シートごとにPDF出力したい】**と思い、
下記VBAを組みましたが、同姓同名の場合に上書きされてしまいます。
同姓同名ファイルが上書きされてほしくないのですが、どうしたらよいでしょうか？
重複する場合、末尾に番号を1から振っていけたらいいのかなと思っております。

シート名がフルネームで「田中太郎」になります
保存後のファイル名は「通知書_田中太郎.pdf」

＜重複した場合＞
「通知書_田中太郎.pdf」と
「通知書_田中太郎1.pdf」が同ファイルに保存されてほしいです。

また、重複しない別名ファイルはそのまま保存されていってほしいです。
以下が理想形のフォルダ群です。

C:\通知書格納フォルダ\通知書格納フォルダ

　　通知書_田中太郎.pdf
　　通知書_田中太郎1.pdf
　　通知書_山田花子.pdf
　　通知書_山本次郎.pdf
　　通知書_山本次郎1.pdf
　　通知書_山本次郎2.pdf

該当のソースコード

VBA
1Sub PDF出力()
2    Dim ws As Worksheet
3    Dim exPath As String
4    Dim Path As String
5    
6    Path = "C:\通知書格納フォルダ"
7    
8    For Each ws In Worksheets
9        exPath = Path & "\通知書_" & ws.Name & ".pdf"
10        ws.ExportAsFixedFormat _
11            Type:=xlTypePDF, _
12            FileName:=exPath, _
13            Quality:=xlQualityStandard
14    Next
15End Sub

基本的にはPathフォルダは空の状態からスタートする予定です。
（出力したPDFは、毎日各個人フォルダへ振り分けるのでPathフォルダから移動する）

試したこと

https://qiita.com/yagi_eng/items/cc7570b3878818a8e495

ここのコードを使えるかもと思い試しましたが、わたくしがそこまで詳しくなく、どこに挿入し修正すればよいのかわかりませんでした。
ご教授いただければ幸いです。
また別の方法でももちろんかまいません。

補足情報（FW/ツールのバージョンなど）

使用ソフトウェア
・Microsoft 365 Excel バージョン2011(ビルド 13426.20308)
・UiPath

退会済みユーザー

2020/12/18 04:15

> どこに挿入し修正すればよいのかわかりませんでした。何がわからなかったのかを詳しく書いてください。参考にされたQiitaに書かれていることと同じことしか回答できないですよ。

tatsu99

2020/12/18 04:31

>基本的にはPathフォルダは空の状態からスタートする予定です。 >（出力したPDFは、毎日各個人フォルダへ振り分けるのでPathフォルダから移動する）上記をきちんと行っていれば、ファイル名の重複は発生しないはずですが、それでも、重複時の処理を実装したいというのは、万が一、上記の処理が行われなかった場合に、備えたいとということでしょうか。

行動規範の内容に同意します

回答5件

同じファイル名が存在する場合は、連番を追加したファイル名を返す関数を作成しておくといいでしょう。
そういう要件はわりとあると思いますので。

標準モジュール

vba
1Public Function GetSaveFileName(Path As String, FileName As String, ext As String)
2    Dim FN As String, i As Long
3    
4    GetSaveFileName = Path & "\" & FileName & "." & ext
5
6    FN = Dir(GetSaveFileName)    
7    Do Until FN = ""
8        i = i + 1
9        GetSaveFileName = Path & "\" & FileName & i & "." & ext
10        FN = Dir(GetSaveFileName)
11    Loop
12End Function

上記の関数を使って質問のコードを書き直すと下記になります。

vba
1Sub PDF出力()
2    Dim ws As Worksheet
3    Dim exPath As String
4    Dim Path As String
5
6    Path = "C:\通知書格納フォルダ"
7
8    For Each ws In Worksheets
9        exPath = GetSaveFileName(Path, "通知書_" & ws.Name, "pdf")
10        ws.ExportAsFixedFormat _
11            Type:=xlTypePDF, _
12            FileName:=exPath, _
13            Quality:=xlQualityStandard
14    Next
15End Sub