送信済みメールと受信メールを別々のフォルダに移動するようにVBAを修正しました。
以下のコードでは、
受信メールは "受信保存フォルダ" に移動
送信メールは "送信保存フォルダ" に移動
---
VBAコード（受信と送信を別フォルダに分けて保存）
Sub MoveIMAPMailAndSentItemsSeparately()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olIMAPInbox As Outlook.Folder
Dim olIMAPSent As Outlook.Folder
Dim olDestInbox As Outlook.Folder
Dim olDestSent As Outlook.Folder
Dim olMail As Object
Dim InboxMoveCount As Integer
Dim SentMoveCount As Integer
' Outlookアプリケーションの取得
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
' IMAPアカウントの受信トレイと送信済みフォルダを取得
On Error Resume Next
Set olIMAPInbox = olNS.Folders("IMAPアカウント名").Folders("受信トレイ")
Set olIMAPSent = olNS.Folders("IMAPアカウント名").Folders("送信済みアイテム")
' 受信メールの保存先フォルダ
Set olDestInbox = olNS.Folders("新しいアカウント名").Folders("受信保存フォルダ")
' 送信メールの保存先フォルダ
Set olDestSent = olNS.Folders("新しいアカウント名").Folders("送信保存フォルダ")
On Error GoTo 0
' フォルダが存在しない場合のエラーチェック
If olIMAPInbox Is Nothing Or olIMAPSent Is Nothing Or olDestInbox Is Nothing Or olDestSent Is Nothing Then
MsgBox "フォルダが見つかりません。フォルダ名を確認してください。", vbExclamation
Exit Sub
End If
InboxMoveCount = 0
SentMoveCount = 0
' 受信トレイのメールを移動
For Each olMail In olIMAPInbox.Items
If TypeName(olMail) = "MailItem" Then
olMail.Move olDestInbox
InboxMoveCount = InboxMoveCount + 1
End If
Next olMail
' 送信済みフォルダのメールを移動
For Each olMail In olIMAPSent.Items
If TypeName(olMail) = "MailItem" Then
olMail.Move olDestSent
SentMoveCount = SentMoveCount + 1
End If
Next olMail
' メッセージ表示
MsgBox "受信メール: " & InboxMoveCount & " 件を移動しました。" & vbCrLf & _
"送信メール: " & SentMoveCount & " 件を移動しました。", vbInformation
' オブジェクト解放
Set olMail = Nothing
Set olIMAPInbox = Nothing
Set olIMAPSent = Nothing
Set olDestInbox = Nothing
Set olDestSent = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
---
設定のポイント
---
実行方法
1. Alt + F11 でVBAエディタを開く
2. 挿入 → 標準モジュール を選択
3. コードを貼り付け
4. Alt + F8 で MoveIMAPMailAndSentItemsSeparately を選択し 実行
---
このVBAの特徴
✅ 受信と送信を別フォルダに分類して移動
✅ フォルダ名が間違っているとエラーメッセージを表示
✅ 移動したメールの件数を表示して確認しやすい
---
追加機能の応用
日付でフィルタ → 1年以上前のメールのみ移動
特定のキーワードでフィルタ → "重要" という件名のメールだけ移動
定期実行（Application.OnTime を使用）
これで送受信のメールをそれぞれ整理できます！試してみて、うまくいかなかったらフォルダ名をチェックしてみてください。