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

”簡易メール送信”関連の今までの記事中の
プロシージャを使われた方はわかると思いますが、
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 には
タイムアウトが必須だということを
実感しました。