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

下記のマクロは先ほど教えて頂いたマクロで、実行をすると指定フォルダと指定ファイルをマウスで指定したフォルダ内にコピーできます。
現状では
「検査時必要図書（正本）」と「返却用（副本）」の2つのフォルダをコピペできますが、
もう一つのフォルダ「前審査」を追加して、3つのフォルダをコピペ出来る方法を教えてください。
現状のマクロ
Sub Macro1()
Const originalFileAddress As String = "\審査用フォルダ\検査時必要図書（正本）"
Const copyFileAddress As String = "\審査用フォルダ\返却用（副本）"
Const SourceFileAddress As String = "\\nas-sp01\share\確認部\電子申請　関連\１．受付\１．確認申請\審査用フォルダ\総合引き受け（戸建て）"
Const FileNewName As String = "総合引き受け（戸建て）"

Dim Dst As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
Dst = .SelectedItems(1)
End With
Dim FSO As Object
Dim Adr As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Adr = ThisWorkbook.Path
If Right(Dst, 1) <> "\" Then Dst = Dst & "\"
FSO.CopyFolder Adr & originalFileAddress, Dst
FSO.CopyFolder Adr & copyFileAddress, Dst

Dim SourceFile As String
Dim Extension As Variant
If Not IsEmpty(Dst) Then
For Each Extension In Array(".xlsm", ".xltm")
SourceFile = SourceFileAddress & Extension
Dim DestinationFile As String
DestinationFile = Dst & "\" & FileNewName & Extension

On Error Resume Next
FileCopy SourceFile, DestinationFile
On Error GoTo 0
Next

End If
End Sub

以上となります。
宜しくお願い致します。

質問者からの補足コメント

• 

  回答ありがとうございます。
  私の説明が悪くて申し訳ありません。
  現状のマクロを実行すると
  フォルダ
  1.「検査時必要図書（正本）」
  2.「返却用（副本）」
  ファイル
  1.「総合引き受け（戸建て）」がコピー先にコピペできますが
  これを
  1.「検査時必要図書（正本）」
  2.「返却用（副本）」
  3.「前審査」
  ファイル
  1.「総合引き受け（戸建て）」
  以上のように「前審査」フォルダをもう一つ指定フォルダ内にコピペしたいのですが。
  解決方法を教えてください。
  宜しくお願い致します。

  No.1の回答に寄せられた補足コメントです。 補足日時：2024/06/21 16:20

• 

  回答ありがとうございます。
  ご連絡が遅くなり申し訳ありません、
  記者に教えて頂きました、コードを設定し、実行したところ、
  エラーメッセージ「実行時エラー76　パスが見つかりません」が表示されて、コードの「FSO.CopyFile SourceFile, DestinationFile」が黄色くなっており、マクロを上手く実行できませんでした。
  コピー先のフォルダには"\検査時必要図書（正本）" "\返却用（副本）" "\前審査"
  はコピーされており、
  ファイル「総合引き受け（戸建て）.xlsm」のみがコピーできませでした。
  申し訳ありません、解決方法を教えてください。
  宜しくお願い致します。

  No.2の回答に寄せられた補足コメントです。 補足日時：2024/06/24 08:29

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2024/06/24 09:41

コピー元ファイルのアドレスは

Const SourceFileAddress As String = "\\nas-sp01\share\確認部\電子申請　関連\１．受付\１．確認申請\審査用フォルダ\総合引き受け（戸建て）"
です。これでコピーされていると書いていますが　何処にあるファイルですか？
コピー元ファルダと同じフォルダにあるファイル？

Extension = ".xlsm"
SourceFile = SourceFileAddress & Extension
DestinationFile = Dst & FileNewName & Extension

を

Extension = ".xlsm"
SourceFile = ThisWorkbook.Path & "\審査用フォルダ\総合引き受け（戸建て）" & Extension
DestinationFile = Dst & FileNewName & Extension

として
Const SourceFileAddress As String = "\\nas-sp01\share\確認部\電子申請 関連\１．受付\１．確認申請\審査用フォルダ\総合引き受け（戸建て）"
を消してください

この回答へのお礼

回答ありがとうございます。
上手くできました。
何時も助けて頂きましてありがとうございます。
感謝いたします。

お礼日時：2024/06/24 10:25

No.2 回答者： Qchan1962 回答日時： 2024/06/23 10:06

Sub test1()

Const Folder1 As String = "\検査時必要図書（正本）"
Const Folder2 As String = "\返却用（副本）"
Const Folder3 As String = "\前審査"
Const SourceFileAddress As String = "\\nas-sp01\share\確認部\電子申請 関連\１．受付\１．確認申請\審査用フォルダ\総合引き受け（戸建て）"
Const FileNewName As String = "総合引き受け（戸建て）"

Dim Dst As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "コピー先フォルダを選択"
If .Show = False Then Exit Sub
Dst = .SelectedItems(1)
End With

Dim FSO As Object
Dim Adr As String
Dim SourceFolder As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
Adr = ThisWorkbook.Path & "\審査用フォルダ"
If Right(Dst, 1) <> "\" Then Dst = Dst & "\"
For Each SourceFolder In Array(Folder1, Folder2, Folder3)
If Dir(Dst & SourceFolder, vbDirectory) = "" Then
FSO.CopyFolder Adr & SourceFolder, Dst
End If
Next

Dim SourceFile As String
Dim DestinationFile As String
Dim Extension As String

Extension = ".xlsm"
SourceFile = SourceFileAddress & Extension
DestinationFile = Dst & FileNewName & Extension

Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(FileNewName & Extension)
If Err.Number = 0 Then
wb.Close False
End If
On Error GoTo 0
FSO.CopyFile SourceFile, DestinationFile
Set FSO = Nothing

End Sub

各フォルダ、ファイルの存在とアクセスを確認する必要があると思いますが

この回答へのお礼

この度も、助けて頂きありがとうございます
教えて頂けました、コードを設定させて頂きます、
結果は後ほど、ご連絡させて頂きます

お礼日時：2024/06/23 11:50

No.1 回答者： fujillin 回答日時： 2024/06/21 16:09

こんにちは

フォルダのコピーを繰り返したいのなら・・
　＞FSO.CopyFolder Adr & originalFileAddress, Dst
　＞FSO.CopyFolder Adr & copyFileAddress, Dst
で行っているので、追加すればよいでしょう。
（変数のネーミングがイマイチ紛らわしいけれど・・）