Outlookで「送信するときに保存先フォルダーを選びたい」のに、Exchangeでは動くVBAがGmail（IMAP）では反応せず、結局「送信済みアイテム」にしか残らない――そんな悩みを一気に解消します。根本原因はたった1行の条件分岐。この記事では原因の仕組みから、Exchange／Gmailの両方で確実に動く最終版コード、実装手順、運用のコツまでを実践的にまとめました。
目次
問題の全体像
同一のOutlookプロファイル内で、ExchangeアカウントではVBAマクロが正常に動作し、送信前にフォルダー選択ダイアログ（PickFolder）を出して保存先を指定できる一方、Gmail（IMAP）アカウントではマクロが発動せず、メールは既定の「送信済みアイテム」にだけ保存される現象が起こります。ユーザー体験としては「Exchangeだけ便利、Gmailは不便」という不一致が発生します。
症状早見表
| 項目 | Exchange アカウント | Gmail（IMAP）アカウント |
|---|---|---|
| 送信時のフォルダー選択ダイアログ | 表示される | 表示されない／後続処理へ進まない |
| 保存先 | 選択したフォルダーに保存 | 既定の「送信済みアイテム」にのみ保存 |
| ユーザー要望 | 両アカウントで同じ操作感（送信時に保存先を選べる）を実現したい | |
原因：DeleteAfterSubmit の既定値差による条件分岐スキップ
元のコードには以下の条件が含まれていました。
If Item.DeleteAfterSubmit = False Then
' 保存先を変える処理…
End If
IMAP メール（Gmail）の場合、DeleteAfterSubmit プロパティが True になる挙動があるため、この条件文を満たせず、以降の保存先切り替え処理がスキップされていました。結果として、Gmail だけが「既定の送信済み」に残り続けるわけです。
プロパティ既定値の違い（傾向）
| プロパティ | Exchange | Gmail（IMAP） | 影響 |
|---|---|---|---|
DeleteAfterSubmit | False | True | True の場合、条件分岐で保存先変更ロジックに到達しない |
SaveSentMessageFolder | 任意のフォルダーを設定・保存可 | 任意のフォルダーを設定・保存可（ただし条件により未到達） | 条件を取り除けば両方で機能する |
解決策：DeleteAfterSubmit を先頭で False 固定 → PickFolder の結果へ保存
アカウント種別に依存しない最小変更で、確実に動くアプローチがこちらです。DeleteAfterSubmit = False を先頭で強制し、その後にユーザーが選んだフォルダーへ直接保存します。移動処理の追加は不要です。
決定版コード（ThisOutlookSession）
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeOf Item Is Outlook.MailItem Then
SaveSentMail Item
End If
End Sub
Private Sub SaveSentMail(Item As Outlook.MailItem)
Dim F As Outlook.Folder ' Outlook.MAPIFolder でも可
Item.DeleteAfterSubmit = False ' ← 先頭で必ず False に固定
Set F = Application.Session.PickFolder
If Not F Is Nothing Then
Set Item.SaveSentMessageFolder = F
End If
End Sub - ポイント1：
DeleteAfterSubmitを最初にFalseにすることで、アカウント種別の差を吸収します。 - ポイント2：
PickFolderはユーザーがキャンセルし得るため、If Not F Is Nothing Thenで安全にガードします。 - ポイント3：
SaveSentMessageFolderに直接フォルダーをセットするので、送信後に移動するロジックは不要です。 - 検証環境：Outlook 2016 以降（Windows 版）で確認。
導入手順（手戻りゼロで確実に）
- Outlook を起動し、Alt+F11 で「Microsoft Visual Basic for Applications」を開く。
- 左ペインの「プロジェクト – VBAProject」内から ThisOutlookSession をダブルクリック。
- 上記の決定版コードを貼り付けて保存（Ctrl+S）。
- Outlook をいったん終了し、再起動。
※「再起動までイベントが効かない」ケースがあるため必ず実施。 - トラスト センター → マクロの設定 で「VBA を有効化」。組織ポリシー配下の場合は管理者の承認や署名付きマクロが必要なことがあります。
- テスト送信：新規メールを作成し送信するとフォルダー選択ダイアログが表示され、選んだフォルダーに保存されれば成功。
運用のコツ（UXとミス防止）
- お気に入りを活用：よく使う保存先をナビゲーションの「お気に入り」に入れておくと
PickFolderでの探索が早くなります。 - アカウント混在時の迷子防止：フォルダー名に接頭辞（例：「営業\_」、「開発\_」）を付けると、同名フォルダーを見分けやすくなります。
- 重複保存の抑止：IMAP（特に Gmail）はサーバー側でも送信済みコピーを作ることがあります。Outlook 側の「送信済みアイテムに保存」設定と合わせて、保存先を一箇所に寄せる方針にしておくと、重複と混乱を防げます。
- 共有メールボックス：他人のメールボックスへ保存する場合は、当該メールボックスへの適切な権限が必要です。
採用しなかった案とその理由
ItemSend+ItemSendCompleteの二段構え：Exchange は直接保存、IMAP は送信後に移動――という構成は実装コストが増え、失敗時の巻き戻し処理も複雑になります。- IMAP で
SaveSentMessageFolder = Nothing：実行時エラーが発生するため例外処理が増え、安定運用に不向きです。
トラブルシューティング
| 現象 | 想定原因 | 対処 |
|---|---|---|
| ダイアログが出ない | 他マクロ／COM アドインが先に処理している／イベント競合 | 不要なアドインを無効化。ItemSend の中で TypeOf チェックを入れて影響範囲を限定 |
| 保存先にコピーされない | DeleteAfterSubmit が True のまま／コードが再起動後に読み込まれていない | 本記事の最終版コードで先頭に DeleteAfterSubmit = False を明記。Outlook を再起動 |
| 会議出席依頼やタスクでエラー | MailItem 以外のアイテムに処理が当たっている | If TypeOf Item Is Outlook.MailItem Then でガード（既に実装済み） |
| 保存先の選択に時間がかかる | フォルダー階層が深い／候補が多い | 「お気に入り」に集約。後述の「前回フォルダー記憶」拡張を検討 |
| 組織環境で実行不可 | マクロ禁止ポリシー／署名必須 | 管理者に相談。自己署名証明書での署名やコード署名の導入 |
安全・セキュリティの留意点
- マクロ有効化：トラスト センターで VBA を許可。組織ポリシーでは署名付きマクロのみ許可される場合があります。
- プログラムによるアクセス：セキュリティ設定により、送信時に警告が表示されることがあります。最新のウイルス対策と信頼済み発行元の署名で不要なプロンプトを抑制できます。
- 最小権限：共有先フォルダーに保存する際は必要なアクセス許可のみ付与。
より快適に：前回選択フォルダーを記憶する（任意の拡張）
毎回 PickFolder を開くのが手間なら、最後に選んだフォルダーをレジストリ（ユーザー領域）へ保存し、次回も同じ場所に保存する拡張が便利です。以下は追加レシピとしての一例です（決定版コードに置き換えではなく、拡張として利用）。
' --- 任意のモジュールに追加 ---
Private Const APP_NAME As String = "OutlookVBA"
Private Const SEC_NAME As String = "SaveSent"
Private Const KEY_FOLDER_ID As String = "FolderID"
Private Const KEY_STORE_ID As String = "StoreID"
Private Function GetLastFolder() As Outlook.Folder
Dim fid As String, sid As String
fid = GetSetting(APP_NAME, SEC_NAME, KEY_FOLDER_ID, "")
sid = GetSetting(APP_NAME, SEC_NAME, KEY_STORE_ID, "")
On Error Resume Next
If fid <> "" And sid <> "" Then
Set GetLastFolder = Application.Session.GetFolderFromID(fid, sid)
End If
On Error GoTo 0
End Function
Private Sub RememberFolder(ByVal F As Outlook.Folder)
On Error Resume Next
SaveSetting APP_NAME, SEC_NAME, KEY_FOLDER_ID, F.EntryID
SaveSetting APP_NAME, SEC_NAME, KEY_STORE_ID, F.StoreID
On Error GoTo 0
End Sub
' --- SaveSentMail を次のように差し替え可能 ---
Private Sub SaveSentMail(Item As Outlook.MailItem)
Dim F As Outlook.Folder
Item.DeleteAfterSubmit = False
Set F = GetLastFolder()
If F Is Nothing Then
Set F = Application.Session.PickFolder
End If
If Not F Is Nothing Then
Set Item.SaveSentMessageFolder = F
RememberFolder F
End If
End Sub この拡張により、同じフォルダーへ連続して保存するケースではダイアログ表示が省略され、入力時間を短縮できます。異なるフォルダーへ保存したい場合は、前述の基本版のまま運用するか、送信前に一時的に拡張を無効化する運用にしてください。
応用：送信アカウントごとに候補を出し分け（任意の拡張）
Exchange と Gmail で保存先を変えたい、部署別に保存先を固定したい――といった要望には、アカウント名とフォルダーの対応表を用意します。参照設定は不要（遅延バインディング）にしてあります。
Private Function ResolveDefaultFolder(ByVal acctName As String) As Outlook.Folder
Dim map As Object 'Scripting.Dictionary
Set map = CreateObject("Scripting.Dictionary")
' --- アカウント表示名とフォルダーの EntryID を対応付け ---
' map("Exchange の表示名") = "EntryID|StoreID"
' map("Gmail の表示名") = "EntryID|StoreID"
Dim pair As String
If map.Exists(acctName) Then
pair = map(acctName)
Dim fid As String, sid As String, p() As String
p = Split(pair, "|")
fid = p(0): sid = p(1)
On Error Resume Next
Set ResolveDefaultFolder = Application.Session.GetFolderFromID(fid, sid)
On Error GoTo 0
End If
End Function
Private Sub SaveSentMail(Item As Outlook.MailItem)
Dim F As Outlook.Folder
Item.DeleteAfterSubmit = False
Dim acctName As String
If Not Item.SendUsingAccount Is Nothing Then
acctName = Item.SendUsingAccount.DisplayName
End If
Set F = ResolveDefaultFolder(acctName)
If F Is Nothing Then
Set F = Application.Session.PickFolder
End If
If Not F Is Nothing Then
Set Item.SaveSentMessageFolder = F
End If
End Sub 運用開始前に、対象フォルダーの EntryID と StoreID を取得して対応表へ入力しておく必要があります（管理者がセットアップして配布するとスムーズです）。
実運用でのベストプラクティス
- 手間の最小化：「常に同じフォルダー」派は前回フォルダー記憶の拡張でクリックを減らす。「案件ごとに変える」派は、お気に入り＋短いフォルダー名で選びやすく。
- ログと再現性：保存先の誤りが問題になる組織では、件名末尾にフォルダー名を入れる社内ルールを加えると追跡しやすくなります（VBAで自動追記も可）。
- ガバナンス：Exchange Online などで「他メールボックスへの保存禁止」や「既定以外禁止」のポリシーがある場合は、運用前に管理者へ相談。
- メンテナンス：Outlook のメジャーアップデート後は、イベントが読み込まれているか（ThisOutlookSession が有効か）を確認。必要なら「コンパイル（デバッグ → VBAProject のコンパイル）」を実行。
技術的補足：なぜ DeleteAfterSubmit を False 固定でよいのか
DeleteAfterSubmit は「送信後にアイテムを削除するか」を示すフラグです。これが True のままだと、保存先の切り替えに進む前提が崩れ、そもそもロジックが走らない実装になりがちです。反対に、先頭で False を強制すれば送信後のアイテムは削除されず、SaveSentMessageFolder で指定した場所へ正しく保存されます。Exchange と IMAP（Gmail）で既定値が異なっても、コードが責務として値を確定するため、挙動を統一できます。
検証環境と再現テストケース
| OS / Outlook | アカウント | テスト観点 | 期待結果 |
|---|---|---|---|
| Windows 10/11 + Outlook 2016/2019/Microsoft 365 | Exchange（MAPI） | 送信時ダイアログ、指定保存 | フォルダー選択後、該当フォルダーへ保存 |
| 同上 | Gmail（IMAP） | DeleteAfterSubmit=False 強制の効果 | ダイアログ表示・指定フォルダーへ保存（既定条件に左右されない） |
| 同上 | 混在プロファイル | アカウント切替時の安定性 | どちらのアカウントでも同一UXを維持 |
FAQ
- Q：会議出席依頼にもダイアログが出ますか？
A：いいえ。本コードはTypeOf Item Is Outlook.MailItemで メール のみを対象にしているため、会議やタスクには影響しません。 - Q：送信時に毎回ダイアログを出したくない。
A：前回フォルダー記憶の拡張を使うか、アカウント別の既定フォルダーを対応表で指定してください。 - Q：Gmail 側の「送信済み」へもコピーが残り、二重になりませんか？
A：組織・アカウント設定によりサーバー側コピーが作成されることがあります。Outlook 側の「送信済みアイテムに保存」設定とポリシーを合わせ、保存先を一箇所に寄せると重複を防げます。 - Q：VBA の参照設定は必要？
A：本記事のコードは Outlook オブジェクトを前提にしており、標準環境で追加の参照は不要です（応用の辞書利用は遅延バインディング）。
まとめ
原因はシンプル――DeleteAfterSubmit の既定値差（特に Gmail/IMAP で True になり得る点）により、保存先変更ロジックへ到達していなかったこと。送信処理の先頭で DeleteAfterSubmit=False を明示し、PickFolder で選んだフォルダーを SaveSentMessageFolder にセットするだけで、Exchange と Gmail の両方で同じ操作感を実現できます。ルールや移動の二段構えは不要。あとは運用の工夫（お気に入り、前回フォルダー記憶、アカウント別の既定化）で、現場の生産性を大きく引き上げられます。
付録：最小実装（貼り付け用）
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeOf Item Is Outlook.MailItem Then
SaveSentMail Item
End If
End Sub
Private Sub SaveSentMail(Item As Outlook.MailItem)
Dim F As Outlook.Folder
Item.DeleteAfterSubmit = False
Set F = Application.Session.PickFolder
If Not F Is Nothing Then
Set Item.SaveSentMessageFolder = F
End If
End Sub チェックリスト（導入時にこの順で確認）
- VBA が「ThisOutlookSession」に正しく保存されている。
- Outlook を再起動した。
- マクロが有効化されている（トラスト センター）。
- テスト送信でフォルダー選択ダイアログが出る。
- 選択したフォルダーに送信済みメールが保存される。
- Exchange と Gmail（IMAP）の双方で同じ動作になる。
実務ポイント（再掲）
- マクロを有効化：トラストセンターのマクロ設定で VBA を許可する。
- フォルダー選択の効率化：保存先は「お気に入り」に登録して選択を簡略化。
- 組織ポリシーの確認：他メールボックスへの保存を制限する設定がある場合は管理者に相談。
- アドイン競合：送信時に他のマクロ／COM アドインが動いているとダイアログが出ないことがある。イベントの優先順位や構成を見直す。
コメント