VBAでPDFを作成する際、同じ名前のデータがすでにある時の対処法を教えてください。

下記コードで、PDFを作成し任意のフォルダー（この場合には 「"C:\sample"」）に保存するのですが、保存先のフォルダーにすでに同じ名前のデータがある場合、上書きせずに、新しいデータとして保存するにはどうすればいいでしょうか？

新しいデータにはわかりやすい様に名前の後ろに「（２）、（３）、、」といったように番号を自動でふってもらえるようになると助かります。

よろしくお願いいたします。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Const OutPath As String = "C:\sample"
Dim FileName As String
FileName = Range("G11").Value & "." & Range("J11").Value & "." & Format(Range("N2").Value, "yymmdd") & "." & Range("D15").Value & ".pdf"
Worksheets("注文書").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=OutPath & "\" & FileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

No.1 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/03/09 19:15

以下のようにしてください。

GetNewNameが名前が重複したとき、重複しない名前を探しだし、
それを返します。

Public Sub sample()
Const outpath As String = "C:\sample"
Dim baseName As String
Dim fullpath As String
Worksheets("注文書").Select
baseName = Range("G11").Value & "." & Range("J11").Value & "." & Format(Range("N2").Value, "yymmdd") & "." & Range("D15").Value
fullpath = GetNewName(outpath, baseName, ".pdf")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=fullpath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
MsgBox (fullpath & "へ出力完了")
End Sub
Private Function GetNewName(ByVal outpath As String, ByVal base As String, ByVal ext As String) As String
Dim fullpath As String
Dim seq As Long
seq = 1
Do
If seq = 1 Then
fullpath = outpath & "\" & base & ext
Else
fullpath = outpath & "\" & base & "(" & seq & ")" & ext
End If
seq = seq + 1
Loop While Dir(fullpath) <> ""
GetNewName = fullpath
End Function

この回答へのお礼

立て続けのご回答ありがとうございました！
お陰で希望通りの結果を得られました。
助かりました！

お礼日時：2021/03/10 10:31