この記事では、Excel VBAを使用して、特定の国コードからのメールを指定したフォルダに自動的に移動する方法について詳しく説明します。初心者でも理解しやすいように具体的なコード例とその解説、応用例を含めています。
目次
はじめに
日常業務において、国別のメールを効率よく管理したい場合があります。特に国際的に取引のある企業や個人で、特定の国からのメールを一覧したいと思ったことはないでしょうか。Excel VBAを使用すると、このような要求を容易に実現できます。
基本的なコードの解説
以下は、特定の国コード(この場合は”.jp”)からのメールを「日本」フォルダへ自動的に移動するVBAコードです。
Sub MoveMailsByCountryCode()
Dim ns As Object
Dim Inbox As Object
Dim MailItem As Object
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(6) ' 6 = olFolderInbox
i = 1
While i <= Inbox.Items.Count
Set MailItem = Inbox.Items(i)
If Right(MailItem.SenderEmailAddress, 3) = ".jp" Then
MailItem.Move ns.GetDefaultFolder(6).Folders("日本")
Else
i = i + 1
End If
Wend
Set MailItem = Nothing
Set Inbox = Nothing
Set ns = Nothing
End Sub
コードの詳細
このコードの主要部分は、メールアイテムの送信者のメールアドレスの末尾3文字を取得し、".jp"であるかどうかを確認する部分です。もしそれが".jp"であれば、そのメールアイテムを「日本」フォルダに移動します。
応用例
応用例1: 複数の国コードを対象とする
特定の国だけでなく、複数の国コードを対象として、それぞれの国のフォルダに振り分けることもできます。
Sub MoveMailsByMultipleCountryCodes()
Dim ns As Object
Dim Inbox As Object
Dim MailItem As Object
Dim countryCode As String
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(6)
i = 1
While i <= Inbox.Items.Count
Set MailItem = Inbox.Items(i)
countryCode = Right(MailItem.SenderEmailAddress, 3)
Select Case countryCode
Case ".jp"
MailItem.Move ns.GetDefaultFolder(6).Folders("日本")
Case ".us"
MailItem.Move ns.GetDefaultFolder(6).Folders("アメリカ")
Case ".uk"
MailItem.Move ns.GetDefaultFolder(6).Folders("イギリス")
Case Else
i = i + 1
End Select
Wend
Set MailItem = Nothing
Set Inbox = Nothing
Set ns = Nothing
End Sub
応用例2: 特定の文言を含むメールの振り分け
国コードだけでなく、メールの件名や本文に特定の文言が含まれている場合に振り分けることもできます。
Sub MoveMailsByKeyword()
Dim ns As Object
Dim Inbox As Object
Dim MailItem As Object
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(6)
i = 1
While i <= Inbox.Items.Count
Set MailItem = Inbox.Items(i)
If InStr(1, MailItem.Subject, "重要", vbTextCompare) > 0 Then
MailItem.Move ns.GetDefaultFolder(6).Folders("重要なメール")
Else
i = i + 1
End If
Wend
Set MailItem = Nothing
Set Inbox = Nothing
Set ns = Nothing
End Sub
応用例3: 日付によるメールの振り分け
特定の期間内に受信したメールを別のフォルダに移動させることもできます。
Sub MoveMailsByDate()
Dim ns As Object
Dim Inbox As Object
Dim MailItem As Object
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(6)
i = 1
While i <= Inbox.Items.Count
Set MailItem = Inbox.Items(i)
If MailItem.ReceivedTime >= Date - 7 Then '過去7日以内のメール
MailItem.Move ns.GetDefaultFolder(6).Folders("最近のメール")
Else
i = i + 1
End If
Wend
Set MailItem = Nothing
Set Inbox = Nothing
Set ns = Nothing
End Sub
まとめ
Excel VBAを活用することで、受信トレイのメールを自動的に整理・振り分けることができます。日常の業務効率を向上させるために、この記事のコードを参考にしてみてください。
コメント