VBAで処理と処理の間に一定時間を空けて実行する方法

投稿日：2019年9月21日更新日：2020年11月1日

今回はVBAで処理と処理の間に一定時間を空けて実行する方法について、備忘も兼ねて記載します。

(０)目次＆概説

(１) Application.wait
(２) サンプルプログラムソース
 (３) サンプルプログラム実行結果

(１) Application.wait

結論としては「Application.wait」メソッドを使います。例えば現在時刻から指定した時間分、インターバルを設けてWaitする場合は以下の様に記載します。

Application.Wait Now() + [Waitする秒数] / 86400

＞目次にもどる

(２) Application.waitサンプルプログラム

次に実際のサンプルプログラムをご紹介します。今回はファイルを「コピー元」⇒「コピー先」に一定の時間を空けてコピーするプログラムです。

Sub CopyFile()

    Dim Fso As FileSystemObject
    Set Fso = New FileSystemObject
    Set wC = ThisWorkbook.Worksheets("CopyTillBlank")
    Dim Bef     As String
    Dim BefSub  As String
    Dim BefFile As String
    Dim BefFix  As String
    Dim Aft     As String
    Dim AftSub  As String
    Dim AftFile As String
    Dim AftFix  As String
    Dim space As String: space = " "
    Dim dollar As String: dollar = "\"
    Dim icnt    As Integer: icnt = 3
    
    While wC.Cells(icnt, 2) <> ""
        
        Bef = wC.Cells(icnt, 2).Value
        BefSub = wC.Cells(icnt, 3).Value
        BefFile = wC.Cells(icnt, 4).Value
        Aft = wC.Cells(icnt, 5).Value
        AftSub = wC.Cells(icnt, 6).Value
        AftFile = wC.Cells(icnt, 7).Value
        icnt = icnt + 1

        'コピー元のフォルダパスの作成  
        If BefSub = "" Then
            BefFix = Bef & dollar & BefFile & quote & space
        Else
            BefFix = Bef & dollar & BefSub & dollar & BefFile & quote & space
        End If
        
        'コピー元のフォルダパスの作成
        If AftSub = "" Then
            AftFix = Command & quote & Aft & dollar & AftFile
        Else
            AftFix = Command & quote & Aft & dollar & AftSub & dollar & AftFile
        End If
        
        'ファイルをコピーする
        Fso.CopyFile BefFix, AftFix
        
        '「E1」セルで指定した時間だけウェイトする
        '待ち時間（秒）を1日の秒数84600で割り算
        Application.Wait Now() + wC.Cells(1, 5).Value / 86400
    
    Wend
    
    MsgBox "コピー完了"

End Sub

＜ポイント＞
・14行～15行目
パスを表現するのに使う「\」や半角スペースを予め変数として定義することで直打ちを防ぎ、ソースの可読性を向上
・18行目
「While wC.Cells(icnt, 2) <> “”」で2列目が空白の行にあたるまで、ループを続けるようにしています
・29行～33行目
サブフォルダ（BefSub）の有無でIf分岐させ、動的にコピー元／コピー先パスを作り分けています。

変数名	変数概要
Bef	コピー元の親フォルダのパス
BefSub	コピー元の子フォルダの名前
BefFile	コピー元のファイル名
BefFix	コピー元の確定パス
Aft	コピー先の親フォルダのパス
AftSub	コピー先の子フォルダの名前
AftFile	コピー先のファイル名
AftFix	コピー先の確定パス
space	パスにスペースを入れたい時用
dollar	パスに「\」マークを入れたい時用
icnt	while文のカウンター

＞目次にもどる

(３) サンプルプログラム実行結果

上記VBAスクリプトを実行すると、下表の「BeforeCopy」配下にある「tif」ファイルが「AfterCopy」の階層の状態でコピーされます。

'コピー元のパス
BeforeCopy
　∟10.tif
　∟aaa
　　∟1.tif
　　∟2.tif
　　∟3.tif
　　∟4.tif
　　∟5.tif
　∟bbb
　　∟6.tif
　　∟7.tif
　　∟8.tif
　　∟9.tif
'マクロ実行後のコピー先のパス状況
AfterCopy
　∟7.tif
　∟8.tif
　∟9.tif
　∟10.tif
　∟ccc
　　∟1.tif
　　∟2.tif
　　∟3.tif
　∟ddd
　　∟4.tif
　　∟5.tif
　　∟6.tif

＞目次にもどる

(４) サンプルVBAファイルのダウンロード

下記のパスにマクロを配備していますので、ご自由にご利用ください。

＜使い方＞
・「CopyTillBlank」シート
1.VBAのプログラムで動作するファイルコピー機能です。
2.コピー元情報(B列,C列,D列)とコピー先情報(E列,F列,G列)を埋めます
3.ボタンを押すと上記の情報を元にコピーを実施します

・「CopyTillBlank2」シート
1.同じくファイルコピー機能ですが、cmd上で実行できるようなコマンドベースのコピーです。
2.コピー元情報(B列,C列,D列)とコピー先情報(E列,F列,G列)を埋めると、自動でH列にコピーコマンドが作成されます。
3.コマンド作成されたら、cmd等を起動してコマンドを貼り付けて実行します

https://www.dropbox.com/s/pqy5ral1p0hydew/HowToCopyFileWithInterval.xlsm?dl=0

＞目次にもどる