質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.46%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Outlook

Microsoft OutlookはMicrosoft Officeの一部として組み込まれている、のユーザー管理とメーラーの機能を持ち合わせたソフトウェアです。

Q&A

3回答

580閲覧

OutlookでVBAを使い、メールの自動転送の転送時間を指定したい。

hirasawonder

総合スコア2

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Outlook

Microsoft OutlookはMicrosoft Officeの一部として組み込まれている、のユーザー管理とメーラーの機能を持ち合わせたソフトウェアです。

0グッド

0クリップ

投稿2024/02/07 12:57

実現したいこと

代理店から自分が受信したメールを、20人の担当者に自動転送したいと思っています。
なお、その代理店から受信するメールは、メール本文に担当者の名前を含むので、”メール本文に特定の文字を含む”という条件設定で転送することが可能です。

しかし、代理店からメール受信する時間がばらばらで、土日を含む24時間受信する可能性があります。
すると、Outlookを立ち上げたタイミングで、土日を含む24時間20人の担当者にメールが自動転送されてしまうため、労務管理上問題が発生してしまいます。そのため、自動転送する日時を指定したいと思っています。(できれば平日の9:00-17:45の間)

調べたところ、OutlookのVBA機能を使えば対応できるようなのですが、設定フロー、特にコードの書き方がわからずご教授頂ける方を探しております。

ご助言を頂けないでしょうか。

何卒よろしくお願い申し上げます。

発生している問題・分からないこと

OutlookのVBA機能の使い方、特にコードの書き方が分からない。

該当のソースコード

特になし

試したこと・調べたこと

  • teratailやGoogle等で検索した
  • ソースコードを自分なりに変更した
  • 知人に聞いた
  • その他
上記の詳細・結果

OutlookのVBA機能を使って、自動転送するコードは見つけたが、加えて時間指定する情報を見つけることができなかった。

補足

特になし

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

otn

2024/02/07 13:16

今までOutlookのVBAを読み書きしたことが無いということであれば道は果てしないと思いますので、 「転送専用のPCを用意して、一定時間の間だけ、OUTLOOKを起動する」(タスクスケジューラをつかうなどして) が簡単かと思います。メールがExchangeメールじゃなくてPOP/IMAPでの受信であればOUTLOOK以外でも良いし。
hirasawonder

2024/02/07 14:33

コメントを頂きありがとうございます。頂いたご提案は会社側の問題で難しそうでした。自分はpythonのコードを読み書きすることはでき、Kaggleに参加できるレベルですがVBAは触ったことがないという状態でした。もし可能でしたらコードをご教授頂くことは可能でしょうか。
guest

回答3

0

代理店から自分が受信したメールを、20人の担当者に自動転送したい

その代理店から受信するメールは、メール本文に担当者の名前を含む

自動転送する日時を指定したいと思っています。(できれば平日の9:00-17:45の間)

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
sk.exe

総合スコア819

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

otn

2024/02/08 08:24

> DeferredDeliveryTime プロパティ こんなものがあるんですね。送る時に送る動作をしないといけないと思ってました。
sk.exe

2024/02/08 09:51

「送る時に送る動作をしないといけない」のはおっしゃる通りです。 あくまで[すべて送受信]アクションや[すべて送信]アクションが実行されても、設定された配信日時に達していなければ送信されないようにしているだけですので。 実際に送信されるタイミングは配信日時を過ぎてから、ユーザーが上記の送受信アクションを実行した時か、もしくは Outlook によって自動送受信が実行された時のいずれかです。 後者の場合は Outlook 側で設定された自動送受信間隔に依存するため、その間隔が極端に長すぎれば、メールに設定された配信日時をかなり過ぎてから送信されてもおかしくはありません。
hirasawonder

2024/02/08 11:35

具体的に教えて頂きありがとうございます。ぜひ参考にさせてください。
sk.exe

2024/02/09 01:31

例示した手法において留意すべき点としては、前述の通り「メールが配信されるタイミングを一定の日時まで遅らせている」だけであり、厳密な意味において「平日9:00~17:45以外の曜日/時間帯にメールを送信しない」ようにしているわけではない、ということです。 例えば、配信日時が2024年2月9日(金)17時40分に設定されたメールが送信トレイに存在している状態で、同日の17時35分に Outlook を一旦終了させ、同日17時50分に再び Outlook を起動させた場合、送信トレイ上のメールに設定された配信日時を既に過ぎているため、Outlook の起動に伴って実行される送受信アクションによってそのメールは送信されることになります。 常時 PC や Outlook を起動しっぱなしにしているならともかく、そのような運用は現実的に難しいかと思います。上記のような事態を回避して「営業時間外には絶対にメールが自動送信されないようにする」には、更に工夫を重ねる必要があるでしょう。
guest

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

shoshinsha123

総合スコア213

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

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
otn

総合スコア84840

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

otn

2024/02/07 15:42

ちょうどOutlook使ってる時に、「あ、いま、裏でプログラム動いてOutlookにアクセスしてるな」という感触があったりするので、実行頻度は必要最小限が良いと思います。
hirasawonder

2024/02/07 16:16

再度返信頂きありがとうございます。参考になりました。さっそく試してみます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.46%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問