マクロでファイル名(を含む)を検索しPDFを開く

質問

マクロでファイル名（セルの値）を含むPDFファイルを検索し、ファイルが存在していればそのファイルを開きたいのですがうまく行きません。

Sub を含むPDFファイルを開く()
Dim keyword As Variant
Dim myPath As Variant
Dim fName
Dim pname

Set my = ActiveSheet

keyword = my.Range("D2").Value '検索する値
myPath = my.Range("F1").Value　　'フォルダパス

fName = Dir(myPath & "*" & keyword & "*" & ".pdf")
pName = (myPath & "*" & keyword & "*" & ".pdf") 　'"*" & keyword & "*"が良くないのだと思います。

If fName = "" Then
MsgBox ("該当するファイルが存在しません。")
Exit Sub

End If

With CreateObject("Wscript.Shell")　

.Run pname, 5　　'ここでエラーが出ます。

End With
End SUB

'pname内の"*" & keyword & "*"をkeywordのみにすると完全一致のファイルは開けるのですが部分一致で開きたいため”*”を使用したところエラーが出てしまいます。
また、検索するPDFファイルにスペースが含まれていても開けるようにしたいのです。
どうかご指導のほうをよろしくお願いします。

回答No.1

mitarashi · ベストアンサー

試してみましたが、Wscript.ShellのRunコマンドにワイルドカードは使用出来ない様です。お望みの事を実現するには、Dirのループを回すしかないかと思います。ご参考まで。
Sub test()
Dim keyword As String
Dim myPath As String
Dim fName As String
Dim pname As String
Dim my As Worksheet
Dim wsh As Object

Set my = ActiveSheet

keyword = my.Range("D2").Value '検索する値
myPath = my.Range("F1").Value 'フォルダパス
Set wsh = CreateObject("Wscript.Shell")

pname = (myPath & "*" & keyword & "*" & ".pdf")
fName = Dir(pname)
If fName = "" Then
MsgBox ("該当するファイルが存在しません。")
Exit Sub
End If
Do Until fName = ""
'Runコマンドにワイルドカードは使えないと思う－試行結果より→ループを回してヒットする物を取得する必要あり
'スペースの入ったパス対策としては""""で囲う必要あり
wsh.Run """" & myPath & fName & """", 5
fName = Dir()
Loop
Dir "" 'ファイルロック解放
Set wsh = Nothing
End Sub

お礼

早速、試してみたところ、自分がやりたいことが出来ました。まだまだ初心者なので調べながらやっていますが、なかなかうまくいかないことが多く困っていたので本当に助かりました。
ありがとうございました！！