マクロやアドインで送信トレイにあるメールの送信がキャンセルされる

コメントにて以下のご質問をいただきました。


はじめて投稿させていただきます。
どうぞ、よろしくお願いいたします。

ThinkPad X230
  Intel Core i7-3520M CPU 2.90 GHz
  RAM 4.00 GB
  Windows 7 SP1 (32 bit)

Outlook 2013

といった環境です。

メールの返信、全員への返信、転送、のときに、
  本文を Plain Text で編集送信できるよう、
  見様見真似で下のようなコードを書きました。

概ねうまく動いているのですが、
1. メール編集
2. 送信ボタン
3. 送信トレイで内容確認
4. 送信ボタン

と、やったときに、送信トレイ内のメール一覧のところで

日付: なし

となり、「送受信」の操作を行っても
  メールが送信されなくなってしまいます。

((各々のメールで送信ボタンを押しても、
すぐにはメールが送信されない設定にして
  あります))

どうも、下のコードの

Private Sub oExpl_SelectionChange()

に、問題があるらしく、

Set oItem = oExpl.Selection.Item(1)
にブレークポイントを入れて、止めておいた状態で

「送受信」の操作

を行うと、メールが送信されます。

ここに、何か条件分岐のコードを入れれば良いように思うのですが、
  見様見真似でありますため、どうすれば良いのか、
さっぱりわかりません。

どうか、ご教示のほど、よろしくお願いいたします。

<<コード省略>>


Private Sub oExpl_SelectionChange() ‘☆どうもここが問題らしいです☆

On Error Resume Next

If oExpl.CurrentFolder.Name = “送信トレイ” Then ‘挿入
Exit Sub ‘挿入
End If ‘挿入

Set oItem = oExpl.Selection.Item(1)

End Sub

で、とりあえず使っております。

上手くいっているようですが、これで、いいんでしょうか。


はい。この対応で問題ありません。

ご質問の動作は、Outlook オブジェクト モデルにより送信トレイにあるアイテムを参照すると、送信処理がキャンセルされるという仕様により発生します。
特定のプロパティにアクセスしたらというようなことではなく、Outlook オブジェクト モデルを使用してアイテムのオブジェクトを取得するという処理をしただけで、送信がキャンセルされます。(ただし、送信トレイのアイテムが送信処理の最中であれば、キャンセルされるのではなくアイテムの取得に失敗します。)

そのため、送信トレイのアイテムは不用意にアクセスしないようにする必要があります。
例えば、アイテムのプレビューなどでも送信がキャンセルされることになるので、送信トレイでは閲覧ウィンドウがオンにできないようになっています。

すでに実装されている「フォルダー名が “送信トレイ” の場合にはアイテムへのアクセスを行わない」という条件分岐でも対応可能ですが、例えば PST にある “送信トレイ” フォルダーではアイテムにアクセスさせたいというような要件があるなら、以下の条件分岐の方が確実でしょう。

If oExpl.CurrentFolder.EntryID = Session.GetDefaultFolder(olFolderOutbox).EntryId Then

広告

選択した範囲を引用して返信するマクロ

コメントにて以下のご要望をいただきました。


はじめまして。

OUTLOOKのメールにおいて
返信時に
受信メール内の特定テキストを
選択
  別位置にペースト
文頭に特定に頭文字(>等)追加
  文字の色を変更
  貼付け
  ということをしています。
※元の文章を引用したいが区別したいため

マクロで
選択部分のテキストを選択した状態で
右Clickメニューからマクロを選択すると
文頭に特定に頭文字(>等)追加
  文字の色を変更
クリップボードに保存
を実現する事はできますでしょうか?

返信コマンド時に受信分全部を
文頭に特定に頭文字(>等)追加
  文字の色を変更
も考えられると思うのですが
過去のやり取りが同じ文字となってしまうので
上記の様な方法が可能であればうれしいのですが


Inspector オブジェクトの WordEditor プロパティを使うと、Outlook が本文の編集に使用している Word のオブジェクトを取得できます。
そして、この Word のオブジェクトを使用すれば、選択された範囲の文字列を取得したり、クリップボードなどを使わずに返信メールに文字列を挿入したりといったことが可能になります。
残念ながら選択範囲を右クリックでマクロを実行することはできませんが、文字列を選択した後でクイックアクセス ツール バーなどに登録した下記のマクロを実行することで、ご要望の動作は実現可能と思われます。

' ここをトリプルクリックでマクロ全体を選択できます。

Public Sub ReplyWithQuotingSelected()
     ' 引用記号の指定
     Const QUOTE_SYM = "> "
     ' 引用する文字列の色 (https://msdn.microsoft.com/ja-jp/vba/word-vba/articles/wdcolor-enumeration-word 参照)
     Const QUOTE_COLOR = 16711680 ' wdColorBlue
     Dim docBody As Object ' Word.Document
     Dim strSel As String
     Dim msgReply As MailItem
     Dim docReply As Object ' Word.Document
     ' 表示しているメールの WordEditor を取得
     Set docBody = ActiveInspector.WordEditor
     ' 選択範囲の文字列を取得
     strSel = QUOTE_SYM & docBody.Application.Selection.Text
     ' 選択範囲の行の頭に引用記号を追加
     strSel = Replace(strSel, vbCr, vbCr & QUOTE_SYM)
     ' 選択範囲の最後が改行の場合は最後の引用記号を削除
     If strSel Like "*" & QUOTE_SYM Then
         strSel = Left(strSel, Len(strSel) - Len(QUOTE_SYM))
     End If
     ' 返信メールを作成
     Set msgReply = ActiveInspector.CurrentItem.ReplyAll
     ' 色を付けるため HTML 形式を設定
     msgReply.BodyFormat = olFormatHTML
     ' メールを表示
     msgReply.Display
     ' 返信メールの WordEditor を取得
     Set docReply = msgReply.GetInspector.WordEditor
     ' 返信メール本文の先頭に移動
     docReply.Range(0, 0).Select
     With docReply.Application.Selection
         ' 引用部分の前に 1 行あける
         .MoveDown
         ' 引用部分の色を指定
         .Font.Color = QUOTE_COLOR
         ' 引用文字列を挿入
         .Text = strSel
     End With
End Sub

マクロの登録方法やメニューへの追加について

複数アカウントが設定されているプロファイルのメイン以外のアカウントの予定表を取得する方法

Outlook の予定表を CSV ファイルにエクスポートするマクロ Ver 2」のコメントにて以下のご質問をいただきました。


Outlook.comにて複数人(3名)の予定表を共有して貰っています。
Outlook2013では自分のアカウントは【個人の予定表】に表示されています。
共有して貰っている複数人(3名)の予定表は【その他の予定表】に表示されています。
で【その他の予定表】に関しては下記の記述で自己解決できたのです。

Set fldCalendar = Application.Session.GetDefaultFolder(olFolderCalendar).Folders(“××××”)
××××には【その他の予定表】に表示されている名前を入力

自分のアカウント【個人の予定表】はOutlook.comのアカウントを予定表を管理するアカウントとしており
メールの送受信は会社のメールアドレスをOutlook2013にアカウント登録しております。
その会社のメールアドレスのアカウントでも予定を管理開始しました。
また、別のアカウント(Outlook.com)を所得しOutlook2013に登録しこちらも予定を管理開始しました。
この二つのアカウントの予定表は【その他の予定表】ではなく
【個人の予定表】下記のような表示となっております。

予定表-aaaaa@Outlook.com
予定表-bbbbb@Outlook.com
予定表-ccccc@*******.com

今日まで予定表-aaaaa@Outlook.comの予定表をエクスポートさせるのには
下記の記述で問題ありませんでした。
Set fldCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)

予定表-ccccc@*******.comの予定表をエクスポートさせるのに下記でチャレンジしましたが
エクスボートされません。
Set fldCalendar = Application.Session.GetDefaultFolder(“ccccc@*******.com”)
Set fldCalendar = Application.Session.GetDefaultFolder(“予定表-ccccc@*******.com”)

どのような記述にすれば良いのでしょうか?
よろしくお願い申し上げます。


Application オブジェクトの Session プロパティ (NameSpace オブジェクト) の GetDefaultFolder メソッドは、既定のアカウントのストアに紐づいているフォルダーしか取得ができません。
しかし、Account オブジェクトの DeliveryStore プロパティから取得した Store オブジェクトの GetDefaultFolder メソッドを使うと、そのアカウントに紐づいている予定表フォルダーなどが取得できます。

例えば、”bbbbb@outlook.com” の予定表を取得したい場合は、以下のようにします。

Dim objAcct As Account
Dim objStore As Store
Dim fldCalendar As Folder
' アカウントの取得
Set objAcct = Application.Session.Accounts("bbbbb@outlook.com")
' ストアの取得
Set objStore = objAcct.DeliveryStore
' 予定表の取得
Set fldCalendar = objStore.GetDefaultFolder(olFolderCalendar)

マクロの登録方法やメニューへの追加について

Outlook 2016/2013/2010 の累積的な修正プログラム 2018 年 4 月分がリリース

4/3 に Outlook 2016、Outlook 2013 および Outlook 2010 の累積的な修正プログラムがリリースされました。
以下は各製品のそれぞれの KB へのリンクです。

Office 2016

Outlook 2016 の修正

2018 年 4 月 3日更新プログラム Outlook 2016 (KB4018326)
6 件の不具合修正と 2 件の機能強化が行われています。

Office 2013

Outlook 2013 の修正

2018 年 4 月 3日は、Outlook 2013 (KB4018303) の更新します。
4 件の不具合修正が行われています。

Office 2013 共通コンポーネントの修正

2018 年 4 月 3日は、Office 2013 (KB3178636) の更新します。
Outlook に関する 1 件の不具合修正が行われています。

Office 2010

Outlook 2010 の修正

2018 年 4 月 3日は、Outlook 2010 (KB4018317) の更新します。
1 件の不具合修正が行われています。

受信したメールに添付されたメッセージの添付ファイルも含めて自動保存するマクロ

受信したメールの添付ファイルを自動保存するマクロ」のコメントにて以下のご要望をいただきました。


お世話になります。『受信したメールの添付ファイルを自動保存するマクロ』を活用させていただいております。「添付ファイルとして転送」として受け取ったメール、つまり、受信メールに添付された「.msg」ファイル、この中に添付されたファイルを保存することはできないでしょうか。添付の添付、みたいなものにアクセスするステートメントがあれば教えて頂きたいです。宜しくお願い致します。


添付されたメッセージに含まれる添付ファイルに直接アクセスするようなメソッドなどはありませんが、添付メッセージをいったんファイルとして保存し、そのファイルをメッセージとして開きなおすことで、添付ファイルにアクセスができるようになります。
以前公開したマクロにこのロジックを追加すると、以下のようなものになります。

' ここをトリプルクリックでマクロ全体を選択できます。

' 添付ファイルを保存するフォルダーの指定
Const SAVE_PATH = "C:\attachments\"
' メール受信時に発生するイベント
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
     Dim i As Integer
     Dim c As Integer
     Dim colID As Variant
     '
     If InStr(EntryIDCollection, ",") = 0 Then
         SaveAttachments EntryIDCollection
     Else
         colID = Split(EntryIDCollection, ",")
         For i = LBound(colID) To UBound(colID)
             SaveAttachments colID(i)
         Next
     End If
End Sub
'
' 添付ファイルの保存を行うサブ プロシージャ
Private Sub SaveAttachments(ByVal strEntryID As String)
     Dim objMsg As Object
     '
     Set objMsg = Application.Session.GetItemFromID(strEntryID)
     '
     ' ここで条件指定
     '
     ' 以下はメール以外のアイテムの場合に処理しないための記述
     If objMsg.MessageClass <> "IPM.Note" Then Exit Sub
     '
     SaveAttachmentsInMsg objMsg
End Sub
'
' メッセージごとの添付ファイルの保存を行うサブ プロシージャ
Private Sub SaveAttachmentsInMsg(ByVal objMsg As MailItem)
     Dim objFSO As Object ' FileSystemObject
     Dim objAttach As Attachment
     Dim strFileName As String
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     ' 添付ファイルすべてについて処理
     For Each objAttach In objMsg.Attachments
         Dim c As Integer
         c = 1
         With objAttach
             strFileName = SAVE_PATH & objAttach.FileName
             ' 既存のファイルと名前が重複したら -数字 をつける
             While objFSO.FileExists(strFileName)
                 strFileName = SAVE_PATH & Left(.FileName, InStrRev(.FileName, ".") - 1) _
                     & "-" & c & Mid(.FileName, InStrRev(.FileName, "."))
                 c = c + 1
             Wend
             .SaveAsFile strFileName
             ' 添付ファイルがメッセージか確認
             If strFileName Like "*.msg" Then
                 Dim objAttachMsg As MailItem
                 ' 保存した msg ファイルをメッセージとして開く
                 Set objAttachMsg = Session.OpenSharedItem(strFileName)
                 ' 開いたメッセージについて添付ファイルの保存処理を行う
                 SaveAttachmentsInMsg objAttachMsg
             End If
         End With
     Next
End Sub

マクロの登録方法やメニューへの追加について

既定の予定表のみを表示して Outlook を起動するスクリプト

コメントにて以下のご要望をいただきました。


こんにちは。
いつも参考にささていただきありがとうございます。

質問よろしくお願いします。

私は社内で365を利用していて、
  沢山のカレンダーを管理しているのですが、
デスクトップにoutlook のカレンダーをワンクリックで開けるように以下のようなショートカットを作ってい利用しています。

“C:\Program Files\Microsoft Office 15\root\office15\outlook.exe” /select outlook:calenders

ただ上記の方法だと、最終利用時に、選んだカレンダーが
  そのまま次回起動時に表示されてしまいます。

毎回リセットされた状態でカレンダーを開く方法などはありますでしょうか?

何卒よろしくお願いします!


Outlook をスクリプトで起動し、既定の予定表を表示することで、ご要望の動作は満たせると思います。
スクリプトは以下のようになります。

' ここをトリプルクリックでスクリプト全体を選択できます。

Const olFolderCalendar = 9
Dim olkApp
Dim fldCal
Set olkApp = CreateObject("Outlook.Application")
Set fldCal = olkApp.Session.GetDefaultFolder(olFolderCalendar)
fldCal.Display

リアルタイムプレビュー表示と添付ファイルプレビューの設定をファイルにエクスポートするスクリプト

コメントにて以下のご要望をいただきました。


[ファイル>オプション]にあります[Outlookのオプション]の情報ですが、こちらを別ファイル(テキストやCSV)で見ることは可能でしょうか。

利用想定として、Outlook基本設定の[リアルタイムプレビュー表示機能を有効にする]の項目をAさんはON / BさんはOFF、セキュリティセンターの[添付ファイルのプレビューをオフにする]の項目をAさんはOFF / BさんはONとなっていることを別ファイルで見たいと考えております。

Outlook:2010
  Windows:7 Enterprise SP1

よろしくお願いいたします。


ご要望の 2 つの設定はそれぞれ以下のレジストリに格納されています。

[リアルタイム プレビュー表示機能を有効にする]

キー: HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings
名前: EnableLivePreview

[添付ファイルのプレビューをオフにする]

キー: HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\14.0\Outlook\Preferences
名前: DisableAttachmentPreviewing

これらのレジストリの値をファイルに保存するようなスクリプトを作成すれば、ご要望は満たせるでしょう。
スクリプトは以下のようになります。

' ここをトリプルクリックでスクリプト全体を選択できます。

Option Explicit
On Error Resume Next
Const EXPORT_FILE="c:\temp\test.txt"
' Outlook 2010
Const REG_ENABLELIVEPREVIEW = "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\EnableLivePreview"
Const REG_DISABLEATTACHMENTPREVIEW = "HKCU\SOFTWARE\Microsoft\Office\14.0\Outlook\Preferences\DisableAttachmentPreviewing"
' Outlook 2013
'Const REG_ENABLELIVEPREVIEW = "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\EnableLivePreview"
'Const REG_DISABLEATTACHMENTPREVIEW = "HKCU\SOFTWARE\Microsoft\Office\14.0\Outlook\Preferences\DisableAttachmentPreviewing"
' Outlook 2016
'Const REG_ENABLELIVEPREVIEW = "HKCU\SOFTWARE\Microsoft\Office\14.0\Common\MailSettings\EnableLivePreview"
'Const REG_DISABLEATTACHMENTPREVIEW = "HKCU\SOFTWARE\Microsoft\Office\14.0\Outlook\Preferences\DisableAttachmentPreviewing"
'
Dim WSHShell
Dim iEnableLivePrev
Dim iDisableAttPrev
'
Set WSHShell = CreateObject("WScript.Shell")
'  [リアルタイム プレビュー表示機能を有効にする] の設定取得
iEnableLivePrev = WSHShell.RegRead(REG_ENABLELIVEPREVIEW)
If Err.Number<> 0 Then
     iEnableLivePrev = 1
     Err.Clear
End If
'  [添付ファイルのプレビューをオフにする] の設定取得
iDisableAttPrev = WSHShell.RegRead(REG_DISABLEATTACHMENTPREVIEW)
If Err.Number<> 0 Then
     iDisableAttPrev = 0
End If
'
Dim objFSO
Dim stmLog
Dim astrOnOff : astrOnOff = Array("OFF", "ON")
'
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set stmLog = objFSO.CreateTextFile(EXPORT_FILE)
stmLog.WriteLine "リアルタイムプレビュー表示機能を有効にする = " & astrOnOff(iEnableLivePrev)
stmLog.WriteLine "添付ファイルのプレビューをオフにする = " & astrOnOff(iDisableAttPrev)
stmLog.Close