Excel マクロによる特定pdfファイルをRenameして複写する方法

Excel　Workシートに記載のファイル名を用いて、特定フォルダーのpdfファイルをRenameして
保存を考えています。検索で下記のプログラムが見つかったのですが、ファイル名を選択て、Enter
を行う必要があります。
多数のpdfファイルをRenameする必要があり、上記のような選択やEnterキーを操作する事なく、
マクロでpdfファイルをRename出来る方法をお教え頂けますようお願いいたします。

Sub PDFリネーム()
Dim InputPDF, OutputPDF_full, OutputPDF_path, OutputPDF_name As Variant
CreateObject(“Wscript.shell”).currentdirectory = “C:\test１\"
InputPDF = Application.GetOpenFilename("PDFファイル”,test.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.2 回答者： WindFaller 回答日時： 2019/07/24 20:09

No.1のお礼欄の内容ですと、ほとんど違う内容です。

むろん、元の質問のコードとも違いますし、今の所、何も参考になるものがなくなった状態です。ひとつの特定のフォルダーの中で、Rename した後、保存したとしても、元のファイルはどうするのか、とか。

いずれにしても、質問に出されたものが参考にならないとすると、訂正とか修正ではなく、全面的にやり直しを意味しています。

>この過程を、一切マウス，キーボードを操作する事なく、実施したいと思います。
という条件だけを優先しているだけで、このままですと、何度も修正を繰り返すようになるように思います。最近、私は、いろんな事情があって、長引く内容のものは、見切ってしまっています。

もし、リクエストに応じたものが必要でしたら、仕様手順をまとめてください。

　・特定のフォルダーと書かれていますが、決まったものなら、最初に規定のフォルダー名を入れることで、ダイアログでフォルダーを選ぶ必要はないということでしょうか。
　・pdfの元ファイル名列　...どの列のことを指しているか?　任意にしても、ある目安は必要です。
　・最終的には自動実行でも、pdf のリストをExcelに貼り付けていただくスタイルのはずです。それは取得できているということでしょうか。
　 ・一定の規則による名前の変更でしたら、修正用のリストは不要のはずです。
　・Renameするファイル名..列　元ファイル名の隣の列だろうか?
　・そもそも、そのつど、pdfのファイル名の一覧をワークシートに貼り付けるのはかなり面倒な作業だと思いますが、その上変更名のリストまで作っているのに、「一切マウス，キーボードを操作する事なく、実施したい」というところには、無理がないでしょうか。

　今の内容では、マクロをお作りするのは無理かもしれません。
簡単なレイアウトでも、見せていただければ、また違う考えが生まれるかもしれません。

No.1 回答者： WindFaller 回答日時： 2019/07/23 08:11

>マクロでpdfファイルをRename出来る方法をお教え頂けますようお願いいたします。

一括でという意味ですね。でも、こういう凝った書き方は、私には、ちょっと荷が重いですね。ファイル名が一律に統一され、"_ver " 後に数字が付くというファイル名になるわけですね。

以下　FileDialog(msoFileDialogFolderPicker)の欠点は、pdf ファイルがあるのかどうか、見れないということです。

'//標準モジュール
Sub PDFrenaming()
　Dim myPath As Variant
　Dim uName As String
　Dim fn As String
　Dim BaseName As String
　Dim DestPath As String
　Dim arFiles() As Variant
　Dim i As Long

　uName = Environ("USERNAME") 'ユーザー名
　With Application.FileDialog(msoFileDialogFolderPicker)
　　If .Show Then
　　　myPath = .SelectedItems(1) & "\"
　　Else
　　　Exit Sub
　　End If
　End With
　'送り先
　DestPath = "C:\Users\" & uName & "\Desktop\"

　With ActiveSheet 'ベースのファイル名
　　BaseName = .Range("A2").Value & .Range("B2").Value
　End With

　fn = Dir(myPath & "*.pdf", vbNormal)
　'配列に置く
　Do While fn <> ""
　　If fn <> "." And fn <> ".." Then
　　　If (GetAttr(myPath & fn) And vbNormal) = vbNormal Then
　　　　ReDim Preserve arFiles(i)
　　　　arFiles(i) = myPath & fn
　　　　i = i + 1
　　　End If
　　End If
　　fn = Dir
　Loop
　If i = 0 Then
　　MsgBox "pdf ファイルが見つかりませんでした", vbExclamation
　　Exit Sub
　End If
　Dim n As Variant
　Dim j As Long, k As Long
　Dim oPath As String
　j = 1　'枝番の初期値
　For Each n In arFiles
　　Do
　　　oPath = DestPath & BaseName & "_ver" & j & ".pdf"
　　　j = j + 1
　　Loop Until Dir(oPath) = ""
　　FileCopy n, oPath
　　k = k + 1
　Next
　If k > 0 Then
　　MsgBox k & "個のファイルをコピーしました。", vbInformation
　End If
End Sub

この回答へのお礼

早速のご回答有難うございました。
実施したい内容ですが、Excelのワークシートに、以下のファイル名が羅列してあります。
　・pdfの元ファイル名列
　・Renameするファイル名列
プログラムとしては、１つの元ファイル名を参照して、Renameファイルを１個保存し
２つ目以降を順次Renameして保存します。
この過程を、一切マウス，キーボードを操作する事なく、実施したいと思います。
再度で申し訳ありませんが宜しくお願い致します。

お礼日時：2019/07/23 20:38