
下記のマクロを以下の条件のように変更出来る方法を教えてください。
マクロを実行するとワイルドカード名のPDFファイルが指定フォルダから指定フォルダ内にコピーされます。
コードの「Case "検査時必要図書(正本)"」ですが、マクロを設定しているフォルダを指定
(仮に今回はフォルダを「テスト部件」としてます。
コードの「Case "返却用(副本)"」ですがマクロを設定しているフォルダ内のフォルダを指定
(今回は:24110955-1_交付用となっておりますが、最初「_」前の半角英数字と8文字と「-」以下の半角英数字と1文字は物件によって変更されますが、「_交付用」は変更されません。
画像のように
テスト物件フォルダ内にある「24001234-1_(仮称)北海太郎(交付用_A3).pdf」を
同じくテスト部件内にあるフォルダ名「24001234-1_交付用」内にコピーを出来る方法を教えてください。
できるだけ詳しいコード迄、親切に教えてください。
現状のマクロ
Sub 交付用()
On Error Resume Next
Dim myPath As Variant
Dim fPath As String, fname As String
fPath = ThisWorkbook.Path
fPath = Left(fPath, InStrRev(fPath, "\") - 1)
myPath = folder_acquisition(fPath)
fname = Dir(myPath(1) & "*(交付用_A3).pdf")
Do While fname <> ""
FileCopy myPath(1) & fname, myPath(2) & fname
fname = Dir
Loop
End Sub
Function folder_acquisition(fPath As String) As Variant()
Dim fso As Object, f As Object
Dim n As Integer
Dim myPath(2) As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
With fso
For Each f In .GetFolder(fPath).SubFolders
Select Case Mid(f.Path, InStrRev(f.Path, "\") + 1)
Case "検査時必要図書(正本)"
myPath(1) = f.Path & "\"
n = n + 1
Case "返却用(副本)"
myPath(2) = f.Path & "\"
n = n + 1
End Select
If n = 2 Then Exit For
Next f
End With
Set fso = Nothing
folder_acquisition = myPath()
End Function
以上となります。

No.1ベストアンサー
- 回答日時:
このコードを、指定のフォルダ名に基づいてPDFファイルをコピーするように変更する方法について、以下で詳しく解説します。
説明と変更のポイント
1. 「検査時必要図書(正本)」のパス指定
ThisWorkbook.Path でマクロがあるフォルダを取得し、その中の「検査時必要図書(正本)」フォルダを参照します。
2. 「返却用(副本)」フォルダの動的な判定
「返却用(副本)」フォルダは、「8桁の英数字-1_交付用」という名前でフォルダ内に存在するため、そのようなパターンを正規表現で確認して目的のフォルダを特定します。
改良したコード
以下が、マクロを変更したコードです。
Sub 交付用()
On Error Resume Next
Dim myPath As Variant
Dim fPath As String, fname As String
fPath = ThisWorkbook.Path
' myPath 変数にフォルダパスを取得
myPath = folder_acquisition(fPath)
' 「交付用_A3」で終わるPDFファイルを取得
fname = Dir(myPath(1) & "*(交付用_A3).pdf")
Do While fname <> ""
' ファイルのコピーを実行
FileCopy myPath(1) & fname, myPath(2) & fname
fname = Dir
Loop
End Sub
Function folder_acquisition(fPath As String) As Variant()
Dim fso As Object, f As Object
Dim n As Integer
Dim myPath(2) As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
' 検査時必要図書(正本)フォルダの取得
myPath(1) = fPath & "\検査時必要図書(正本)\"
' フォルダ内のサブフォルダを走査し、「_交付用」で終わるものを見つける
For Each f In fso.GetFolder(fPath).SubFolders
Dim folderName As String
folderName = Mid(f.Path, InStrRev(f.Path, "\") + 1)
' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合
If folderName Like "########-#_交付用" Then
myPath(2) = f.Path & "\"
n = n + 1
End If
' 必要なフォルダが見つかったら終了
If n = 2 Then Exit For
Next f
Set fso = Nothing
folder_acquisition = myPath()
End Function
コードの詳細な説明
1. メインプロシージャ 交付用()
• fPath をマクロの保存されているフォルダに設定します。
• folder_acquisition(fPath) を呼び出して、必要なフォルダのパスを myPath に取得します。
• myPath(1) の中にある「交付用_A3」で終わるPDFファイルをループで探し、myPath(2) にコピーします。
2. 補助関数 folder_acquisition(fPath As String) As Variant()
• myPath(1) に「検査時必要図書(正本)」フォルダのパスを直接指定しています。
• For Each f In fso.GetFolder(fPath).SubFolders でサブフォルダをループし、フォルダ名が「8桁の英数字-1_交付用」に一致するものを探します。
• Like "########-#_交付用" の条件を使い、該当するフォルダのパスを myPath(2) に格納します。
動作確認
1. 実行前に「検査時必要図書(正本)」フォルダと、「8桁の英数字-1_交付用」に一致するフォルダが存在することを確認します。
2. マクロを実行し、指定フォルダにファイルが正しくコピーされるかを確認します。
これで、「検査時必要図書(正本)」と「8桁の英数字-1_交付用」フォルダ間でPDFファイルのコピーが行われるはずです。
上記は生成AIの解答です。
参考になれば幸いです。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルのマクロについて教えてください 物件ごとのフォルダを作成してます そのフォルダ内にサブフォル 2 2023/07/02 17:58
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/07/02 11:48
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/07/01 12:54
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/07/03 09:11
- Android Excelのマクロについて教えてください。 3 2024/06/21 15:13
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2024/01/16 16:33
- Visual Basic(VBA) マクロについて教えてください。 下記のマクロは以前教えて頂いたマクロです。 マクロを実行すると 指定 6 2024/01/17 17:50
- Visual Basic(VBA) あるフォルダーのファイルを違う親フォルダーのサブフォルダーに移したい 11 2023/02/15 19:00
- Microsoft ASP エクセルのマクロについて教えてください。 1 2023/10/18 10:16
- Access(アクセス) エクセルのマクロについて教えてください。 2 2023/02/03 16:07
このQ&Aを見た人はこんなQ&Aも見ています
-
あなたの「必」の書き順を教えてください
ふだん、どういう書き順で「必」を書いていますか? みなさんの色んな書き順を知りたいです。 画像のA~Eを使って教えてください。
-
スマホに会話を聞かれているな!?と思ったことありますか?
スマートフォンで検索はしてないのに、友達と話していた製品の広告が直後に出てきたりすることってありませんか? こんな感じでスマホに会話を聞かれているかも!?と思ったエピソードってありますか?
-
今の日本に期待することはなんですか?
目まぐるしく、日本も世界も状況が変わる中、あなたが今の日本に期待することはなんですか?
-
この人頭いいなと思ったエピソード
一緒にいたときに「この人頭いいな」と思ったエピソードを教えてください
-
泣きながら食べたご飯の思い出
泣きながら食べたご飯の思い出を教えてください。
-
Visualbasicの現状について教えてください
Visual Basic(VBA)
-
【ExcelVBA】5万行以上のデータ比較の効率的な処理方法について
Visual Basic(VBA)
-
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
-
4
以下のプログラムの実行結果はどうなると思いますか? その理由も教えてください。
Visual Basic(VBA)
-
5
サブフォルダに格納されているファイルを、ファイル名ごとに条件分岐させたい
Visual Basic(VBA)
-
6
VBA コードどこがおかしいですか?
Visual Basic(VBA)
-
7
VBA初心者です。次のVBAコードで、17行目を削除したいのですがうまく動きません 改善策を教えてく
Visual Basic(VBA)
-
8
EXCEL vbaでシート上に配置したボタンの移動については
Visual Basic(VBA)
-
9
エクセル タブの下のメニューを選択 実行するコード
Visual Basic(VBA)
-
10
エクセルvbaの対象セルに色をつける 例えば a日付 b種類 c値段 dその他 にんじん 50 ぴー
Visual Basic(VBA)
-
11
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
12
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
13
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
14
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
15
VBAのエラー表示の対処法について
Visual Basic(VBA)
-
16
VB.net 文字列から日付型へ変更したい
Visual Basic(VBA)
-
17
エクセルVBAコードで教えて下さい!
Visual Basic(VBA)
-
18
VBの色を変えるにはどうしたらいいですか?
Visual Basic(VBA)
-
19
プログラミング
Visual Basic(VBA)
-
20
VBAコードのインデント表示
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルのVBAコードについて教...
-
VBAの「To」という語句について
-
えくせるのVBAコードについて教...
-
Excelのマクロについて教えてく...
-
VBAでFOR NEXT分を Application...
-
算術演算子「¥」の意味について
-
VBAでユーザーフォームを指定回...
-
【VBA】 結合セルに複数画像と...
-
マクロVBAです。 どなたかコー...
-
エクセルのマクロについて教え...
-
エクエルのVBAコードについて教...
-
vbaマクロについて
-
VBAから書き込んだ条件付き初期...
-
【VBA】値を変更しながら連続で...
-
現在のブックを閉じないで、マ...
-
以下のプログラムの実行結果は...
-
エクセルのマクロについて教え...
-
VBA ユーザーフォーム ボタンク...
-
2つのマクロでチェックボックス...
-
VBAについてです。 どなたかご...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VB.net 文字列から日付型へ変更...
-
VBA 最終行の取得がうまくいか...
-
VBAでエクセルのテキストデータ...
-
【ExcelVBA】5万行以上のデー...
-
エクセルVBAで在庫の組み換え処...
-
VBAから書き込んだ条件付き初期...
-
エクセルのVBAコードについて教...
-
VBAでユーザーフォームを指定回...
-
エクセルのVBAについて教えてく...
-
vbaマクロについて
-
ExcelのVBAコードについて教え...
-
【VBA】 結合セルに複数画像と...
-
WindowsのOutlook を VBA から...
-
質問58753 このコードでうまく...
-
ExcelのVBAコードについて教え...
-
Excel VBAについて。こんな動作...
-
[Excel VBA]特定の条件で文字を...
-
[VB.net] ボタン(Flat)のEnable...
-
エクエルのVBAコードについて教...
-
ExcelのVBAコードについて教え...
おすすめ情報
回答ありがとうございます。
早速試してみます。
後ほど、結果を報告させていただきます。