エクセルのマクロについて教えてください。

下記のマクロを実行すると、指定したPDFファイルのオリジナル名（元々のファイル）の後ろに
指定セル値「V1」の値がプラスされて、PDF名が変更になります。
例えば「12345678-5北海　太郎.pdf」がオリジナル名
「V1」に「_9月5日（交付用）」とあった場合には
マクロを実行すると
「12345678-5北海　太郎_9月5日（交付用）.pdfと変更されます。
このマクロですと、マクロ設定ブックのフォルダ内に変更されたPDFファイルが保存されてしまいます。
元のPDFファイル（オリジナル）が保存されているフォルダ内に変更されたPDFファイルを保存出来る方法を教えてください。
現状のマクロ
Sub 交付用名前変更()
Dim TargetFile As String
Dim fPath As String, fname As String
Dim newfName As String

newfName = ThisWorkbook.Sheets("管理表").Range("V1").Value & ".pdf"
newfName = NGNarrowToWide(newfName)

''メッセージを表示し、実施確認する。
If MsgBox(newfName & vbCrLf & vbCrLf & "（交付用）を作成しますか。", vbExclamation + vbOKCancel) <> vbOK Then Exit Sub

' ファイルのパスを指定
fPath = ThisWorkbook.Path

' ダイアログを表示してファイルを選択
TargetFile = Application.GetOpenFilename("PDFファイル ,*.pdf", , "ファイルを選択", , False)
If TargetFile = "False" Then Exit Sub
newfName = CreateObject("Scripting.FileSystemObject").GetBaseName(TargetFile) & newfName

If Dir(fPath & "\" & newfName) = "" Then
Name TargetFile As fPath & "\" & newfName
Else
Dim rc As Integer
rc = MsgBox("既に存在する名前です" & vbCrLf & "はいを押すと既存ファイルは削除され" & vbCrLf & "リネームファイルに置き換えられます", vbExclamation + vbYesNo, "置き換え確認")
If rc = vbYes Then
Kill fPath & "\" & newfName
Name TargetFile As fPath & "\" & newfName
Else
MsgBox "処理を中止しました"
End If
End If
End Sub
Public Function NGNarrowToWide(ByVal stg As String) As String
stg = Replace(Replace(Replace(Replace(stg, "\", "￥"), "/", "／"), ":", "："), "*", "＊")
stg = Replace(Replace(Replace(Replace(stg, "?", "？"), "<", "＜"), ">", "＞"), "|", "｜")
stg = Replace(stg, """", Chr(&H8168))
NGNarrowToWide = stg
End Function
以上となります。
よろしくお願いいたします。

No.1 ベストアンサー 回答者： Ogre7077 回答日時： 2024/09/05 09:53

> マクロ設定ブックのフォルダ

fPath = ThisWorkbook.Path
で取得した場所なので当然です

> 元のPDFファイル（オリジナル）が保存されているフォルダ

GetParentFolderName メソッドで取得しましょう
https://learn.microsoft.com/ja-jp/office/vba/lan …

この回答へのお礼

回答ありがとうございました。
参考にして試してみます。

お礼日時：2024/09/05 10:48