![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
下記のマクロを実行すると
連続して指定マクロが実行されます。
しかし、
マクロ「フォルダコピー新規」を実行した後に「戸建てファイルコピー」を実行すると
それぞれ保存先を聞いてきます。
マクロ「戸建てファイルコピー」の場合は保存先を聞いてこず、「フォルダコピー新規」で指定したフォルダ内に保存出来る方法を教えてください。
現状のマクロ
Sub 新規引き受け()
Call フォルダコピー新規
Call 戸建てファイルコピー
End Sub
それぞれのマクロ
Sub 戸建てファイルコピー()
Const FileNewName As String = "総合引き受け(戸建て)"
Dim Destinationfolder As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "保存先フォルダを選択してください"
.InitialFileName = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\"
If .Show = False Then Exit Sub
Destinationfolder = .SelectedItems(1)
End With
Dim SourceFile As String
Dim Extension As Variant
For Each Extension In Array(".xlsm", ".xltm")
SourceFile = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\審査用フォルダ\総合引き受け(戸建て)" & Extension
Dim DestinationFile As String
DestinationFile = Destinationfolder & "\" & FileNewName & Extension
On Error Resume Next
FileCopy SourceFile, DestinationFile
On Error GoTo 0
Next
End Sub
と
Sub 戸建てファイルコピー()
Const FileNewName As String = "総合引き受け(戸建て)"
Dim Destinationfolder As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "保存先フォルダを選択してください"
.InitialFileName = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\"
If .Show = False Then Exit Sub
Destinationfolder = .SelectedItems(1)
End With
Dim SourceFile As String
Dim Extension As Variant
For Each Extension In Array(".xlsm", ".xltm")
SourceFile = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\審査用フォルダ\総合引き受け(戸建て)" & Extension
Dim DestinationFile As String
DestinationFile = Destinationfolder & "\" & FileNewName & Extension
On Error Resume Next
FileCopy SourceFile, DestinationFile
On Error GoTo 0
Next
End Sub
になります。
宜しくお願い致します。
No.4ベストアンサー
- 回答日時:
すみません 中途半端なコードを加えていました
同名ファイルがあって開いている想定を外して
下の方
On Error Resume Next
Open DestinationFile For Append As #1
Close #1
If Err.Number > 0 Then
Workbooks(FileNewName & Extension).Close False
On Error GoTo 0
End If
FileCopy SourceFile, DestinationFile
On Error GoTo 0
Next
を
On Error Resume Next
FileCopy SourceFile, DestinationFile
On Error GoTo 0
Next
に書き換えてみてください
No.3
- 回答日時:
他の回答者様がおっしゃる通りCallしないでまとめた方が無難かと
処理が合っているかはわかりませんが とりあえず
Sub 新規引き受け()
Const originalFileAddress As String = "\審査用フォルダ\検査時必要図書(正本)"
Const copyFileAddress As String = "\審査用フォルダ\返却用(副本)"
Const SourceFileAddress As String = "\\nas-sp01\share\確認部\電子申請 関連\1.受付\1.確認申請\審査用フォルダ\総合引き受け(戸建て)"
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
Open DestinationFile For Append As #1
Close #1
If Err.Number > 0 Then
Workbooks(FileNewName & Extension).Close False
On Error GoTo 0
End If
FileCopy SourceFile, DestinationFile
On Error GoTo 0
Next
End If
End Sub
No.1
- 回答日時:
こんにちは
別ルーチンになっているので、引数で渡すかグローバルな変数で渡すかなどの方法で値を受け渡すことは可能です。
とは言っても、(分割してあることに意味があるのかないのかわかりませんけれど)普通に考えれば、他でもそのルーチンを利用している可能性があるので、下手に弄るとそちらで不具合が出かねません。
確実なのは、(長いものではないので)「展開して、ご希望の内容に纏める」ようにしてしまえば、他に影響を与えることもなく実現できるでしょう。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Access(アクセス) エクセルのマクロについて教えてください。 2 2023/02/03 16:07
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2024/03/26 18:09
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/11/08 10:31
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2024/03/28 12:00
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/01/26 09:50
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/02/22 08:53
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/02/17 11:59
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/20 16:59
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2024/04/02 16:12
このQ&Aを見た人はこんなQ&Aも見ています
-
「環境が人を育てる」って本当?環境によって人格や生き方は本当に変わるのか
環境が人生に与える影響は実際どれほどのものなのか、専門家の田宮由美さんに伺った。
-
Excel 範囲指定スクショについて Excelで範囲指定してスクリーンショットする機能がありますが
Visual Basic(VBA)
-
エクセルVBAコードで教えて下さい!
Visual Basic(VBA)
-
WORD VBA プログラム修正をお願いします。
Visual Basic(VBA)
-
-
4
プログラミング
Visual Basic(VBA)
-
5
VBAコードについて教えてください。
Visual Basic(VBA)
-
6
vba アクティブシートの名前変更について教えてください
Visual Basic(VBA)
-
7
VBの色を変えるにはどうしたらいいですか?
Visual Basic(VBA)
-
8
Excelのマクロについて教えてください。
Visual Basic(VBA)
-
9
Excel(M365) Vlookup/セル反転(VBA)について
Visual Basic(VBA)
-
10
エクセルVBAについて
Visual Basic(VBA)
-
11
テキストファイルのフィールド行のみ削除したい
Visual Basic(VBA)
-
12
Excel VBA 定義されたプロージャ名、関数名の取得
Visual Basic(VBA)
-
13
Vba SelStart、SelLen教えてください教えてください
Visual Basic(VBA)
-
14
ExcelのVBAコードについて教えてください。
Visual Basic(VBA)
-
15
VBA一覧取得 再投稿
Visual Basic(VBA)
-
16
VBA指定行削除
Visual Basic(VBA)
-
17
VBAでCOPYを繰り返すと、処理が途中でアイドルする原因はなんでしょうか
Visual Basic(VBA)
-
18
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
19
エクセルのマクロについて教えてください。
Visual Basic(VBA)
-
20
Excel-VBAのmsgBox()の不思議
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで複数のコメントのサ...
-
エクセルのハイパーリンクがコ...
-
バッチファイルのコピーで
-
frxファイルの役目
-
開いている別のファイルにExcel...
-
Vba初心者です。下記のコード助...
-
パワポでスライドをコピーでき...
-
VB6でのファイルコピーの終了検...
-
[エクセル]コピーするとオブジ...
-
ファイルサーバ上のファイルが...
-
FSO.CopyFileでのエラー無視方法
-
ExeclVBAユーザーフォームから...
-
バッチファイル 別ファイルにリ...
-
ゴミ箱に移動するような削除を...
-
VPN経由でExcelを開くのが遅い
-
xcopyでのバッチコピー方法でコ...
-
HTMLからXMLに
-
FTPとファイルコピーの違いにつ...
-
アクセス クエリを別のファイ...
-
VB6で、Form1をコピーする方法...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで複数のコメントのサ...
-
エクセルのハイパーリンクがコ...
-
frxファイルの役目
-
バッチファイル XCOPYで上書き...
-
Vba初心者です。下記のコード助...
-
Excelのマクロについて教えてく...
-
エクセル2010、図が大きすぎま...
-
バッチファイル 別ファイルにリ...
-
[エクセル]コピーするとオブジ...
-
パワポでスライドをコピーでき...
-
エクセルVBAで開いているファイ...
-
ファイルサーバ上のファイルが...
-
xcopyでのバッチコピー方法でコ...
-
Excelのマクロについて教えてく...
-
FTPとファイルコピーの違いにつ...
-
バッチファイルのコピーで
-
Excelのマクロについて教えてく...
-
bat 同名ファイルコピー時にリ...
-
アクセス クエリを別のファイ...
-
同じファイル名 上書きしないフ...
おすすめ情報
回答ありがとうございます。
Call 戸建てファイルコピー
のコードを変更すれば良いのでしょうか?
申し訳ありません。
詳しく教えて頂けますでしょうか?
宜しくお願い致します。
回答ありがとうございます。
質問に乗せていませんでした、申し訳ありません。Sub フォルダコピー新規()
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 & "\審査用フォルダ\検査時必要図書(正本)", Dst
FSO.CopyFolder Adr & "\審査用フォルダ\返却用(副本)", Dst
End Sub
となります。宜しくお願い致します。
回答ありがとうございます。
上手くできたのですが、「総合引き受け(戸建て)」が2つ保存されてしましました。
1.総合引き受け(戸建て)サイズが1.134KB
2.総合引き受け(戸建て)サイズが0KB
画像をお送りできませんでしたので、
以上でご確認をお願いいたします。
解決方法を教えてください。
何度も申し訳ありません。宜しくお願い致します。
Qchan1962さん
先日はありがとう御座いました。
貴者が教えて頂けたコード利用して、追加変更をしたい質問を昨日
させて頂きました。
勝手なお願いですが、助けていた出来ますと幸いです。
https://oshiete.goo.ne.jp/qa/13846128.html
よろしくお願いします。