実現したいこと
代理店から自分が受信したメールを、20人の担当者に自動転送したいと思っています。
なお、その代理店から受信するメールは、メール本文に担当者の名前を含むので、”メール本文に特定の文字を含む”という条件設定で転送することが可能です。
しかし、代理店からメール受信する時間がばらばらで、土日を含む24時間受信する可能性があります。
すると、Outlookを立ち上げたタイミングで、土日を含む24時間20人の担当者にメールが自動転送されてしまうため、労務管理上問題が発生してしまいます。そのため、自動転送する日時を指定したいと思っています。(できれば平日の9:00-17:45の間)
調べたところ、OutlookのVBA機能を使えば対応できるようなのですが、設定フロー、特にコードの書き方がわからずご教授頂ける方を探しております。
ご助言を頂けないでしょうか。
何卒よろしくお願い申し上げます。
発生している問題・分からないこと
OutlookのVBA機能の使い方、特にコードの書き方が分からない。
該当のソースコード
特になし
試したこと・調べたこと
- teratailやGoogle等で検索した
- ソースコードを自分なりに変更した
- 知人に聞いた
- その他
上記の詳細・結果
OutlookのVBA機能を使って、自動転送するコードは見つけたが、加えて時間指定する情報を見つけることができなかった。
補足
特になし
気になる質問をクリップする
クリップした質問は、後からいつでもMYページで確認できます。
またクリップした質問に回答があった際、通知やメールを受け取ることができます。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2024/02/07 14:33
回答3件
0
代理店から自分が受信したメールを、20人の担当者に自動転送したい
その代理店から受信するメールは、メール本文に担当者の名前を含む
自動転送する日時を指定したいと思っています。(できれば平日の9:00-17:45の間)
-
NewMailEx イベントの発生時に、受信した個々のメールアイテム( Outlook.MailItem オブジェクト)を参照し、メール転送の是非を判定する。
-
その Outlook.MailItem オブジェクトが転送の条件を満たしていた場合は Forward メソッドを実行し、コピーされたメールアイテム( Outlook.MailItem オブジェクト)を参照する。
-
転送する Outlook.MailItem オブジェクトの To プロパティ(または CC プロパティや BCC プロパティ)に転送先となるメールアドレスを、DeferredDeliveryTime プロパティに任意の転送日時を設定しておき、Send メソッドを実行する。
vba
1'ThisOutlookSession モジュール 2Option Explicit 3 4'受信トレイに新しいアイテムを受信する時に発生するイベント 5Private Sub Application_NewMailEx(ByVal EntryIDCollection As String) 6 7 Dim varEntryIDs As Variant 8 Dim objItem As Object 9 Dim i As Long 10 Dim miForward As Outlook.MailItem 11 12 '受信したアイテムのエントリ ID を 1 次元配列に変換 13 varEntryIDs = Split(EntryIDCollection, ",") 14 15 '全てのエントリIDを1つずつ走査 16 For i = LBound(varEntryIDs) To UBound(varEntryIDs) 17 '受信したアイテムを参照 18 Set objItem = Application.Session.GetItemFromID(varEntryIDs(i)) 19 'そのメールを転送すべきと判断される場合 20 If ShouldForward(objItem) = True Then 21 '転送用のコピーを作成 22 Set miForward = objItem.Forward 23 'このアイテムが自動転送されたメールであることを示すようにする 24 miForward.AutoForwarded = True 25 '配信予約の設定 26 If ScheduleForwardingMail(miForward) = False Then 27 '失敗した場合は作成したメールを削除する 28 miForward.Delete 29 Set miForward = Nothing 30 Set objItem = Nothing 31 'このプロシージャを抜ける 32 Exit Sub 33 End If 34 Set miForward = Nothing 35 End If 36 Set objItem = Nothing 37 Next 38 39End Sub 40 41'メール転送の条件を満たしているか否かを判定し、その結果を Boolean 型の値で返す関数 42Private Function ShouldForward(Target As Object) As Boolean 43 44 ShouldForward = False 45 46 If Target Is Nothing Then 47 Exit Function 48 End If 49 50 '以下の条件のいずれかに該当する場合は転送しない 51 52 'アイテムの種類がメールアイテムではない 53 If Not TypeOf Target Is Outlook.MailItem Then 54 Exit Function 55 End If 56 57 With Target 58 59 '送信者アドレスが不一致 60 If .SenderEmailAddress <> "代理店の送信者アドレス" Then 61 Exit Function 62 End If 63 64 '本文にキーワードが含まれていない 65 If Not .Body Like "*担当者の名前*" Then 66 Exit Function 67 End If 68 69 End With 70 71 '以上の全ての判定を抜けたら True を返す 72 ShouldForward = True 73 74End Function 75 76'メールの配信予約を行う関数 77Private Function ScheduleForwardingMail(Target As Outlook.MailItem) As Boolean 78On Error GoTo Err_ScheduleForwardingMail 79 80 ScheduleForwardingMail = False 81 82 If Target Is Nothing Then 83 Exit Function 84 End If 85 86 Dim dtDelivery As Date 87 88 With Target 89 90 '宛先の設定 91 .To = "転送先メールアドレス" 92 93 '(念のため)現在のシステム日時の 10 分後を既定の配信日時とする 94 dtDelivery = DateAdd("n", 10, Now()) 95' 'テスト用の日時 96' dtDelivery = #2/9/2024 5:45:00 PM# 97 '更に配信日時の補正を行う 98 dtDelivery = CorrectDeliveryTime(dtDelivery) 99 'メールアイテムの配信日時を設定 100 .DeferredDeliveryTime = dtDelivery 101 Debug.Print "配信日時:" & Format(.DeferredDeliveryTime, "yyyy/mm/dd hh:nn:ss") 102 103 'メールを送信(配信日時以降に送受信が実行されるまでは送信トレイに留め置かれる) 104 .Send 105 106 End With 107 108 '送信に成功したら True を返す 109 ScheduleForwardingMail = True 110 111Exit_ScheduleForwardingMail: 112 113 Exit Function 114 115'エラー時処理 116Err_ScheduleForwardingMail: 117 118 Dim strErrTitle As String 119 Dim strErrMsg As String 120 121 strErrTitle = "実行時エラー (ThisOutlookSession.ScheduleForwardingMail)" 122 strErrMsg = "自動転送メールの作成処理中に以下の実行時エラーが発生しました。" & vbCrLf & _ 123 Err.Number & ": " & Err.Description & vbCrLf & _ 124 "このメッセージボックスが閉じられるまで、全てのコードは中断されます。" 125 126 Debug.Print strErrMsg 127 128 MsgBox strErrMsg, vbCritical, strErrTitle 129 130End Function 131 132'配信日時を補正した結果を返す 133Private Function CorrectDeliveryTime(InitialDateTime As Date) As Date 134 135 Dim dtDeliveryDate As Date 136 Dim dtDeliveryTime As Date 137 138 '配信日付の取得 139 dtDeliveryDate = DateValue(InitialDateTime) 140 '配信日時の取得 141 dtDeliveryTime = TimeValue(InitialDateTime) 142 143 '配信時刻により条件分岐 144 Select Case dtDeliveryTime 145 '9時00分よりも早い時刻の場合 146 Case Is < #9:00:00 AM# 147 '当日の9時00分に変更する 148 dtDeliveryDate = #9:00:00 AM# 149 '17時45分以降の時刻の場合 150 Case Is >= #5:45:00 PM# 151 '翌日の9時00分に変更する 152 dtDeliveryDate = DateAdd("d", 1, dtDeliveryDate) 153 dtDeliveryTime = #9:00:00 AM# 154 Case Else 155 '何もしない 156 End Select 157 158 Dim lngWeekday As Long 159 160 '配信日付の曜日(月曜始まり)を取得 161 lngWeekday = Weekday(dtDeliveryDate, vbMonday) 162 163 '土日のいずれかである場合 164 If lngWeekday > 5 Then 165 '直近の月曜日の9時00分に変更する 166 dtDeliveryDate = DateAdd("d", 8 - lngWeekday, dtDeliveryDate) 167 dtDeliveryTime = #9:00:00 AM# 168 End If 169 170 '補正した配信日時を戻り値として返す 171 CorrectDeliveryTime = dtDeliveryDate + dtDeliveryTime 172 173End Function
投稿2024/02/08 06:07
編集2024/02/09 02:36総合スコア923
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2024/02/08 08:24
2024/02/08 09:51
2024/02/08 11:35
2024/02/09 01:31
0
OutlookのVBAを使用して自動転送するプログラムを作成する方法の1つを説明します。
検証していませんので、参考程度にとどめておいてください。
1.Outlookを開き、「開発」タブを選択します。開発タブが表示されていない場合は、Outlookのオプションから有効にする必要があります。
2.「Visual Basic」アイコンをクリックして、Visual Basic for Applications (VBA) エディタを開きます。
3.VBAエディタで、「Insert」メニューから「Module」を選択し、新しいモジュールを挿入します。
4.新しいモジュールに以下のコードを貼り付けます。
Sub ForwardEmails() Dim olApp As Outlook.Application Dim olNS As Outlook.NameSpace Dim olInbox As Outlook.Folder Dim olItems As Outlook.Items Dim olMail As Object Dim olForward As Outlook.MailItem Dim i As Integer ' Outlookアプリケーションを取得 Set olApp = New Outlook.Application ' 名前空間を取得 Set olNS = olApp.GetNamespace("MAPI") ' 受信トレイフォルダを取得 Set olInbox = olNS.GetDefaultFolder(olFolderInbox) ' 受信トレイのアイテムを取得 Set olItems = olInbox.Items ' 送信先のメールアドレスを指定 Dim recipientEmail As String recipientEmail = "example@example.com" ' 送信先の担当者の名前とメールアドレスのマッピングを作成 Dim recipientsMapping As Object Set recipientsMapping = CreateObject("Scripting.Dictionary") recipientsMapping.Add "担当者1の名前", "email1@example.com" recipientsMapping.Add "担当者2の名前", "email2@example.com" ' 他の担当者も同様に追加します ' ループしてメールを転送 For Each olMail In olItems ' 特定の条件を満たすメールを転送 If InStr(1, olMail.Body, "特定の文字列") > 0 Then ' 担当者の名前を取得 Dim recipientName As String recipientName = "担当者名" ' 名前に対応するメールアドレスを取得 Dim recipientAddress As String recipientAddress = recipientsMapping(recipientName) ' メールを転送 Set olForward = olMail.Forward olForward.Recipients.Add recipientAddress olForward.Send ' オリジナルのメールを削除(必要に応じてコメントアウト解除) ' olMail.Delete End If Next olMail ' リソースを解放 Set olApp = Nothing Set olNS = Nothing Set olInbox = Nothing Set olItems = Nothing Set olMail = Nothing Set olForward = Nothing End Sub
このコードは、受信トレイ内のメールをループして特定の条件(メール本文に特定の文字列が含まれるかどうか)を満たす場合に転送します。転送先は、指定した担当者の名前に基づいて動的に決定されます。コード内のコメントを参考に、必要に応じて変更を加えてください(例:オリジナルのメールを削除するかどうかなど)。
コードを書き換えたら、保存して実行してみてください。自動転送が正しく機能するはずです。
投稿2024/02/08 01:23
総合スコア215
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
0
コードをご教授頂くことは可能でしょうか。
ExcelVBAとは異なり、OutlookVBAをリファレンスを引き引きでなく、すらすら書ける人は少ないと思います。つまり、面倒くさい。また、個人的には勤務先ではやむなくOUTLOOKを使ってるのでスクリプトを書いたこともありますが、プライベートではOUTLOOKを使う必要が無いのでテスト環境が無いです。勤務先で書くわけに行かないし。
私が勤務先で必要にせまられて書くなら、VBScriptで書いてタスクスケジューラーから希望時間帯に数分ごとに起動ですかね。
VBScriptでもExcelVBAでもPythonでもRubyでも、Outlook操作は可能です。書き方はOutlookVBAとほぼ同じ。
ググルとPythonだとpywin32とかwin32comとかを使うようです。
プログラミング経験が十分あるなら、(OutlookVBA以外を使う場合はOUTLOOKオブジェクトの作り方だけググル)
https://learn.microsoft.com/ja-jp/office/vba/api/overview/outlook
を見ながらできるかと思います。ちょっと、クラス構成になれる必要がありますが。
・前回処理時刻以降に受信したメール(select構文で抽出可能なはず)を抽出
・それぞれについて、条件にマッチするかチェック
・マッチしたメールを転送
でしょうか。
送信時刻だと前後する可能性がある(送信日時から数時間経って受信するとか)ので、受信時刻で抽出ですね。
境目で取りこぼしや重複が発生しないような工夫も必要かもしれません。
これを、月~金の9:00-17:45に5分毎とかでタスクスケジューラから起動する。祝日どうするかによっては、プログラム冒頭で祝日チェックしてスキップするとかも。月9:00には週末分処理するの5分で終わらない可能性があるなら、そのあたりも工夫要ですね。他の曜日の9:00も夜間分の処理があるので同じく。
投稿2024/02/07 15:40
編集2024/02/07 16:11総合スコア85603
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2024/02/07 15:42
2024/02/07 16:16
あなたの回答
tips
太字
斜体
打ち消し線
見出し
引用テキストの挿入
コードの挿入
リンクの挿入
リストの挿入
番号リストの挿入
表の挿入
水平線の挿入
プレビュー
質問の解決につながる回答をしましょう。 サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。 また、読む側のことを考えた、分かりやすい文章を心がけましょう。