Excel VBAを使用して特定の国コードからのメールを別のフォルダに移動する方法

この記事では、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を活用することで、受信トレイのメールを自動的に整理・振り分けることができます。日常の業務効率を向上させるために、この記事のコードを参考にしてみてください。