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

Question

下記のマクロは先ほど教えて頂いたマクロで、実行をすると指定フォルダと指定ファイルをマウスで指定したフォルダ内にコピーできます。
現状では
「検査時必要図書（正本）」と「返却用（副本）」の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

以上となります。
宜しくお願い致します。

Qchan1962 · Accepted Answer

コピー元ファイルのアドレスは
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\確認部\電子申請 関連\１．受付\１．確認申請\審査用フォルダ\総合引き受け（戸建て）"
を消してください

Qchan1962 · Answer

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

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

fujillin · Answer

こんにちは

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

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

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

Sub test1()

こんにちは

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング