いらっしゃいませ、259037番目のお客様。  

[Outlook]実用(?)マクロ集

このページに含まれるプログラム、ファイル等については、

  1. 一応、著作権は放棄してません。転載等される方は私にご連絡ください。
  2. 内容については万全を期していますが、利用については自己責任でお願いします。いかなる損害にも責任を負いません。
  3. 動作確認は、(1)Windows 98+Excel 2000; (2)Windows XP+Excel 2002で行っています。
以上の点にご注意願います。


目次

  1. 未読メールをチェックする
  2. 開封確認の確認ダイアログ

Office VBAの部屋に戻る

未読メールをチェックする(2002/9/8)

Outlookで自動仕分けをしている場合、フォルダが多いと知らないところで未読メールがたまってしまうことがあります。特に、個人用フォルダの直下や表示されていないサブフォルダに入っていってしまうと、ぜんぜん気づかなかったりします。
そこで、未読メールがたまっているフォルダをダイアログボックスで表示して選択実行することによって、未読メールを自動的に開くプログラムを作成しました。次の3つのファイルをOutlookのVBE(Alt+F11で開きます)にインポート(ファイルメニューにあります)したのち、 Outlookからマクロ(未読チェック)を実行してください。(ユーザー設定でボタンに登録すると便利です。)

このプログラムでポイントといえば、時間のかかるループを使用しているので、DoEventsでループ途中で処理をいったんOutlookに返している点と、そのループに2重にアクセスしないようにループが回っている間は、再びサブルーチンを呼び出さないようにしているところです。

プログラム

Private ActiveUnreadCheck As Integer 'ループの状態を表す変数

Sub 未読チェック()
--- 略 ---
    If ActiveUnreadCheck <> 0 Then 'ループが回っている(0以外になっている)とプログラムを終了。
        MsgBox "現在実行中です。"
        Exit Sub
    End If
--- 略 ---
    UnreadCheck fs	'サブルーチンの呼び出し
--- 略 ---
End Sub

Private Sub UnreadCheck(fs As Outlook.Folders) 'サブルーチン
--- 略 ---
    ActiveUnreadCheck = 1 'ループが回っていることを示す。
    For Each f In fs
--- 略 ---
        DoEvents 'Outlookに処理を返す。
    Next f
    ActiveUnreadCheck = 0 'ループが終わったことを示す。
End Sub


目次に戻る

開封確認の確認ダイアログ(2002/9/13)

メールによって開封確認をしたいことがありますよね?ところが、使おうとなるとメニューがどこにあるのかわからない。また、下書き途中で、つい、送信ボタンを押してしまった。私用メールが全社員に配られちゃったよー。ということがあると思います。そこで、送信ボタンを押すと開封確認するかどうかを確認するダイアログを表示し、キャンセルすることによって送信もキャンセルする(文章は消えません)プログラムを作りました。ThisOutlookSession内に記述してください。

プログラム

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    On Error GoTo ErrorTrap
    Dim Flag As Integer
    Const Kaifu As Integer = 2
    '0:開封確認しない、1:開封確認する、2:選択する、0-2以外:オプションの設定を適用
    If Item.Class = olMail Then
        Select Case Kaifu
        Case 0
            Flag = vbNo
        Case 1
            Flag = vbYes
        Case 2
            Flag = MsgBox("開封確認を行いますか?", vbYesNoCancel + vbQuestion, "開封確認")
        Case Else
            If Item.ReadReceiptRequested Then Flag = vbYes Else Flag = vbNo
        End Select
        If Flag = vbYes Then
            Item.ReadReceiptRequested = True
            If MsgBox("開封確認付きでメールを送信します。", vbOKCancel + vbExclamation, Title:="開封確認あり") = vbOK Then Cancel = False Else Cancel = True
        ElseIf Flag = vbNo Then
            Item.ReadReceiptRequested = False
            If MsgBox("開封確認なしでメールを送信します。", vbOKCancel + vbExclamation, Title:="開封確認なし") = vbOK Then Cancel = False Else Cancel = True
        Else
            Cancel = True
        End If
    End If
    Exit Sub
ErrorTrap:
    Cancel = True
End Sub

ダイアルアップで無い環境の方に特にお勧めです。


目次に戻る

にゃま夫のへや   ・Office VBA   ・おもちゃ箱   ・iαppli
ホームページに戻る。
無断転載を禁じます。
にゃま夫