Excelのマクロについて教えてください。

下記のマクロは先日教えて頂いた、マクロです。
コピー元の指定フォルダ内の指定ファイル名「■北海道_20230731更新.pdf」の
「_20230731更新」この部分が点検終了日付をしてしており、都度、変更になります。
ワイルドカードを利用して「■北海道*」をコピー先にコピー出来る方法を教えてください。
又、コピー後は元のファイル名+「_Copy.pdf」となるようにお願いいたします。
現状のマクロ
Sub 北海道条例()
On Error Resume Next
Dim targetCities As Variant
Dim city As String
Dim isExcluded As Boolean
Dim copyFilePath As String
Dim destinationFilePath As String

' 特定の都市名リスト
targetCities = Array("旭川市", "釧路市", "札幌市", "室蘭市", "小樽市", "帯広市", "苫小牧市", "函館市", "北見市")

' セル F3 の都市名を取得
city = Sheets("受付").Range("F3").Value

' 都市名がリストに含まれているかどうかをチェック
isExcluded = False
For Each c In targetCities
If city = c Then
isExcluded = True
Exit For
End If
Next c

' リストに含まれていない場合
If Not isExcluded Then
' コピー元のファイルパス
copyFilePath = "\\nas-sp01\share\確認部\■共通\審査の注意点\条例・細則【確認申請添付】\■北海道_20230731更新.pdf"

' コピー先のファイルパス
destinationFilePath = ThisWorkbook.Path & "\■北海道_20230731更新_Copy.pdf"

' ファイルをコピー
FileCopy copyFilePath, destinationFilePath
End If
End Sub
以上となります。
よろしくお願いいたします。

No.1 ベストアンサー 回答者： 河内のおやじ 回答日時： 2024/06/12 11:31

Sub 北海道条例()

On Error Resume Next
Dim targetCities As Variant
Dim city As String
Dim isExcluded As Boolean
Dim sourceFolder As String
Dim filePattern As String
Dim sourceFileName As String
Dim destinationFilePath As String

' 特定の都市名リスト
targetCities = Array("旭川市", "釧路市", "札幌市", "室蘭市", "小樽市", "帯広市", "苫小牧市", "函館市", "北見市")

' セル F3 の都市名を取得
city = Sheets("受付").Range("F3").Value

' 都市名がリストに含まれているかどうかをチェック
isExcluded = False
For Each c In targetCities
If city = c Then
isExcluded = True
Exit For
End If
Next c

' リストに含まれていない場合
If Not isExcluded Then
' コピー元のフォルダ
sourceFolder = "\\nas-sp01\share\確認部\■共通\審査の注意点\条例・細則【確認申請添付】\"
' ファイルのパターン
filePattern = "■北海道*.pdf"

' 指定されたパターンに一致するファイルを検索
sourceFileName = Dir(sourceFolder & filePattern)

' 一致するファイルが見つかった場合
If sourceFileName <> "" Then
' コピー先のファイルパス
destinationFilePath = ThisWorkbook.Path & "\" & Replace(sourceFileName, ".pdf", "_Copy.pdf")
' ファイルをコピー
FileCopy sourceFolder & sourceFileName, destinationFilePath
Else
MsgBox "指定されたパターンに一致するファイルが見つかりませんでした。", vbExclamation
End If
End If
End Sub

この回答へのお礼

回答ありがとうございました。
この度も助けて頂きまして感謝いたします。

お礼日時：2024/06/12 11:39