VBAでPDFのコピーとリネームを行いたい

フォルダAに入っているPDFをフォルダBにコピーしたいです。
その際セルに入っている文字列をファイル名に使います。（セルは固定）
また、コピー先に同名のファイルがあったら連番にしたいです。

Sub PDFリネーム()

Dim InputPDF, OutputPDF_full, OutputPDF_path, OutputPDF_name As Variant
Dim Version As Long

CreateObject("Wscript.shell").currentdirectory = "C:\Users\ユーザー名\Downloads\"
InputPDF = Application.GetOpenFilename("PDFファイル,*.pdf", , "ファイルを選択")
If InputPDF = False Then
Exit Sub
End If

OutputPDF_path = "C:\Users\ユーザー名\Desktop\"
OutputPDF_name = Range("A2").Value & "_" & Range("B2").Value
OutputPDF_full = OutputPDF_path & OutputPDF_name & ".pdf"

If Dir(OutputPDF_full) <> "" Then
Version = 2
OutputPDF_name = OutputPDF_name & "_ver" & Version
OutputPDF_full = OutputPDF_path & OutputPDF_name & ".pdf"
Version = Version + 1
End If

FileCopy InputPDF, OutputPDF_full

End Sub

これだとVer2までは作れますが、Ver2もある場合のVer3、４・・・が作れません。
どうしたらよいでしょうか。

No.3 回答者： WindFaller 回答日時： 2017/11/24 12:50

ユーザー名の所は、正しいかどうかは分かりません、マニュアルで入れても構いません。

以下は、拡張子を変えれば、何にでも使えます。
変数名は、こちらで使うものに替えました。

'//
Sub Copy_changeName()
Dim fName As Variant
Dim oBaseName As String
Dim BaseName As String
Dim ofName As String
Const EXT As String = ".pdf"
Dim j As Long

Dim myID As String: myID = Environ("UserName")
Dim myDLPoint As String: myDLPoint = "C:\Users\" & myID & "\Downloads\"
Dim dstPath As String: dstPath = "C:\Users\" & myID & "\Desktop\"
Dim cPath As String: cPath = CurDir

oBaseName = Range("A2").Value & "_" & Range("B2").Value
If oBaseName Like "*_" Then
　MsgBox "正しくファイル名が入っていません", vbCritical
　Exit Sub
End If

ChDir myDLPoint
fName = Application.GetOpenFilename("PDFファイル,*.pdf", , "ファイルを選択")
If fName = False Then
　GoTo Endline
End If
''枝番付け
　BaseName = oBaseName
　Do While Dir(dstPath & BaseName & EXT) <> ""
　　　j = j + 1
　　　BaseName = oBaseName & "_ver" & CStr(j)
　Loop

FileCopy fName, dstPath & BaseName & EXT
Endline:
ChDir cPath
End Sub
'//

No.2 回答者： tatsu99 回答日時： 2017/11/24 11:49

作り変えました。

以下のようにしてください。
-----------------------------------------
Sub PDFリネーム()

Dim InputPDF, OutputPDF_full, OutputPDF_path, OutputPDF_name As Variant

CreateObject("Wscript.shell").currentdirectory = "C:\Users\ユーザー名\Downloads\"
InputPDF = Application.GetOpenFilename("PDFファイル,*.pdf", , "ファイルを選択")
If InputPDF = False Then
Exit Sub
End If

OutputPDF_path = "C:\Users\ユーザー名\Desktop\"
OutputPDF_name = Range("A2").Value & "_" & Range("B2").Value
OutputPDF_full = Get_PDF_full(OutputPDF_path, OutputPDF_name)

FileCopy InputPDF, OutputPDF_full

End Sub

Private Function Get_PDF_full(ByVal OutputPDF_path As String, ByVal OutputPDF_name As String) As String
Dim version As Long
Get_PDF_full = OutputPDF_path & OutputPDF_name & ".pdf"
If Dir(Get_PDF_full) = "" Then Exit Function
version = 1
Do
version = version + 1
Get_PDF_full = OutputPDF_path & OutputPDF_name & "_ver" & version & ".pdf"
Loop While Dir(Get_PDF_full) <> ""
End Function

No.1 回答者： yokomaya 回答日時： 2017/11/24 10:25

それは

Version = 2
と固定しているからでしょ？

InputPDFから判別する様にするだけですけど
数字が最後につくファイル名があり得ないのか
等、考慮すべきことはあります。