一定時間ごとに繰り返し実行する

一定時間ごとに繰り返し実行する方法は
いろいろあると思います。

OnTimeメソッドを使った方法を考えてみます。
OnTimeメソッドの使い方は

OnTime "実行したい時刻", "実行したいプロシージャの名前"

macro100810aは、
1秒ごとにA1セルに現在の時刻を入れていきます。
A60セルまで時刻を入れたら終了します。

コードはこちら

Sub macro100810a()
'一定間隔で実行する
'OnTimeメソッドを使う
   
    Range("A1").Insert shift:=xlDown
    Range("A1") = Format(Now(), "hh:mm:ss")
   
    If Range("A60") = "" Then
        '1秒後にmacro100810aを実行
        Application.OnTime Now() + TimeValue("00:00:01"), "macro100810a"
    Else
        Range("A1:A60").Clear
    End If
   
End Sub

実行中のシートの様子：

自分で自分を呼び出すところに
ちょっとパラドックスに陥りそうになります。

確実性を増した簡易メール送信

”簡易メール送信”関連の今までの記事中の
プロシージャを使われた方はわかると思いますが、
SendKeysを使っているので失敗することがあります。

これはSendKeysが実行されるときに
キーを送りたいウィンドウが
最前面にない(出現してない)ことがあるためです。

記事『 簡易メール送信』の
簡易メールを送信するコードに沿って
この事について説明します。

パソコンの状態によって
メールのウィンドウが出現するまでの時間が異なるので、
とりあえず5秒待って送信するところ

Application.Wait Time:=Now + TimeValue("00:00:05")

で5秒待ってもメールのウィンドウが出ずに
ウィンドウがないまま
送信のショートカットキー{Alt} + SをSendKeysで送る

SendKeys "%{s}", True

これが送信を失敗する過程です。

そこで
SendKeysを実行する直前に
AppActivateステートメントを使って
特定のウィンドウを最前面に出して
簡易メール送信の確実性を増したいと思います。

まあ、
どこまでいっても”簡易”メール送信には違いありません。

AppActivateステートメントの使い方は

AppActivate title

titleにウィンドウのタイトルバーのタイトルの文字列を指定します。
たとえばExcelのウィンドウをアクティブにしたいときは

AppActivate "Microsoft Excel"

になります。

Excelのシートに作ったメールのリンクをクリックすると
出てくるメールのウィンドウのタイトルは
メールの件名になっています。

AppActivate メールの件名

でこのウィンドウをアクティブにできます。

まだウィンドウが出ていない状態で
AppActivateを使うとエラーになります。
そこでOn Error Resume Nextを使ってこのエラーを無視します。
エラーが起きたかどうかを

If Err <> 0 then
　…
End If

で調べます。
エラーが起きてない時はErr = 0 、
エラーが起きた時はErr <> 0 です。

エラーが起きたということは
まだメールのウィンドウが出ていないので
Retryまで戻りエラーが出なくなるまで繰り返します。

また、何らかの理由で
いつまで待ってもメールのウィンドウが出てこない状態に備えて、
タイムアウトの時間を設定します。
タイムアウトするとメールは送信できませんが
実行中のプロシージャを中断したままの状態を回避できます。

なお、本文（=Str2）はオプションにしました。

コードはこちら

Sub SendMail100805(Str1 As String, Optional Str2 As String)
'Str1をメールの件名で
'Str2をメールの本文で送る
    Debug.Print Now() & "　SendMail100805実行"
   
    'タイムアウトの時間を50秒に設定
    Dim MyTime As Date
    MyTime = Now() + TimeValue("00:00:50")
   
    '記事『簡易メール送信』を参照
    With ActiveWorkbook.Sheets("mail").Range("A1").Hyperlinks(1)
        .EmailSubject = Str1 '件名
        .Follow NewWindow:=False, AddHistory:=True
Retry:
        'とりあえず2秒待つ
        Application.Wait Time:=Now + TimeValue("00:00:02")
        On Error Resume Next
            'メールのウィンドウをアクティブにしようとする
            AppActivate Str1
            
            'エラーが起きたかどうかを確認
            If Err <> 0 Then
                'タイムアウトの時間を過ぎたかどうか確認
                If Now() < MyTime Then
                    Debug.Print Now() & "　SendMail100805でエラー:" & Err
                    Err = 0
                    GoTo Retry
                Else
                    'タイムアウト
                    Debug.Print Now() & "　SendMail100805でタイムアウト"
                    Exit Sub
                End If
            End If
        On Error GoTo 0
       
        'Str2（本文）を指定したとき
        If Str2 <> "" Then
            Application.Wait Time:=Now + TimeValue("00:00:01")
            SendKeys "{TAB 3}", True
            Application.Wait Time:=Now + TimeValue("00:00:01")
            SendKeys Str2, True
            Application.Wait Time:=Now + TimeValue("00:00:01")
        End If
       
        '送信のショートカットキーをSendKeysする
        SendKeys "%{s}", True
    End With
End Sub
Sub macro100805a()
'SendMail100805の使い方
'本文ありのメールを送信

    Call SendMail100805("件名", "本文")
   
End Sub
Sub macro100805b()
'SendMail100805の使い方
'件名だけのメールを送信

    Call SendMail100805("件名")
   
End Sub

これで失敗は格段に少なくなりました。

最近、
Do While … Loop には
タイムアウトが必須だということを
実感しました。

よくある質問20100803

コンパイルエラー:
Sub または Function が定義されていません。

と表示される。

ある記事内のあるプロシージャを実行してこのようなエラーが起こる場合は
該当記事より以前の記事で書いた
自作のプロシージャ(Sub)や
ファンクションプロシージャ(Function)を利用しています。

これらがないためにこのエラーが起こります。

面倒ですが
下の画像のようにエラーが起きたときに、
紺色で反転した箇所の
自作のプロシージャ、ファンクションプロシージャの名前をキーワードに
Googleで検索をして探してください。

記事が見つかったら、
自作のプロシージャ、ファンクションプロシージャを
標準モジュールにコピペしてから
エラーが起こったプロシージャを実行してみてください。

エラーなく実行できるようになると思います。