vba - Outlook から添付ファイルをダウンロードして Excel で開く

Question

Excel で VBA を使用して、Outlook 電子メールの Excel スプレッドシートの添付ファイルをダウンロードして開こうとしています。どうやって：

Outlook の受信トレイの最初のメール (最新のメール) から唯一の添付ファイルをダウンロードする
添付ファイルを指定されたパス (例: "C:...") のファイルに保存します。
添付ファイルの名前を次のように変更します:現在の日付+以前のファイル名
「C:...」などのパスを使用して、メールを別のフォルダーに保存します。
Outlook でメールを「既読」にします
Excel で Excel の添付ファイルを開く

また、個々の変数に割り当てられた個々の文字列として以下を保存できるようにしたいと考えています。

送信者のメールアドレス
受領日
送信日
主題
メールのメッセージ

これは別の質問で尋ねる/自分で探す方が良いかもしれませんが.

私が現在持っているコードは、オンラインの他のフォーラムからのものであり、おそらくあまり役に立ちません。ただし、ここに私が取り組んできたいくつかの断片があります。

Sub SaveAttachments()
    Dim olFolder As Outlook.MAPIFolder
    Dim att As Outlook.Attachment
    Dim strFilePath As String
    Dim fsSaveFolder As String

    fsSaveFolder = "C:\test\"

    strFilePath = "C:\temp\"

    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    For Each msg In olFolder.Items
        While msg.Attachments.Count > 0
            bflag = False
            If Right$(msg.Attachments(1).Filename, 3) = "msg" Then
                bflag = True
                msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
                Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
            End If
            sSavePathFS = fsSaveFolder & msg2.Attachments(1).Filename


    End If
End Sub

score 76 · Accepted Answer

一度に完全なコードを提供することはできますが、それでは学習の助けにはなりません ;) それでは、リクエストを分割して、1 つずつ対応していきましょう。 )

7 つすべて (6 ではなく 7) のポイントをカバーする合計 5 つのパートがあるため、7 番目のポイントに対して新しい質問を作成する必要はありません。

パート1

Outlook への接続の作成
未読メールがないか確認する
、、、、などSender email Addressの詳細Date receivedを取得するDate SentSubjectThe message of the email

このコード例を参照してください。Excel から Outlook を使用して遅延バインディングを行ってから、未読のアイテムがあるかどうかを確認し、関連する詳細を取得しています。

Const olFolderInbox As Integer = 6

Sub ExtractFirstUnreadEmailDetails()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object

    '~~> Outlook Variables for email
    Dim eSender As String, dtRecvd As String, dtSent As String
    Dim sSubj As String, sMsg As String

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Store the relevant info in the variables
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        eSender = oOlItm.SenderEmailAddress
        dtRecvd = oOlItm.ReceivedTime
        dtSent = oOlItm.CreationTime
        sSubj = oOlItm.Subject
        sMsg = oOlItm.Body
        Exit For
    Next

    Debug.Print eSender
    Debug.Print dtRecvd
    Debug.Print dtSent
    Debug.Print sSubj
    Debug.Print sMsg
End Sub

そのため、変数に詳細を保存することについて話しているリクエストに注意してください。

パート2

次のリクエストに移ります

Outlook の受信トレイの最初のメール (最新のメール) から唯一の添付ファイルをダウンロードする
添付ファイルを指定されたパス (例: "C:...") のファイルに保存します。
添付ファイルの名前を次のように変更します: 現在の日付 + 以前のファイル名

このコード例を参照してください。私は再び Excel から Outlook で遅延バインドし、未読のアイテムがあるかどうかを確認し、添付ファイルがあるかどうかをさらに確認し、関連するフォルダーにダウンロードしたかどうかを確認します。

Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\"

Sub DownloadAttachmentFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                '~~> Download the attachment
                oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                Exit For
            Next
        Else
            MsgBox "The First item doesn't have an attachment"
        End If
        Exit For
    Next
 End Sub

パート - 3

次のリクエストに進みます

「C:...」などのパスを使用して、メールを別のフォルダーに保存します。

このコード例を参照してください。これにより、C:\ と言うメールが保存されます

Const olFolderInbox As Integer = 6
'~~> Path + Filename of the email for saving
Const sEmail As String = "C:\ExportedEmail.msg"

Sub SaveFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Save the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.SaveAs sEmail, 3
        Exit For
    Next
End Sub

パート - 4

次のリクエストに進みます

Outlook でメールを「既読」にします

このコード例を参照してください。これにより、メールがとしてマークされreadます。

Const olFolderInbox As Integer = 6

Sub MarkAsUnread()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Mark 1st unread email as read
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.UnRead = False
        DoEvents
        oOlItm.Save
        Exit For
    Next
 End Sub

パート - 5

次のリクエストに進みます

エクセルでエクセルの添付ファイルを開く

上記のようにファイル/添付ファイルをダウンロードしたら、以下のコードでそのパスを使用してファイルを開きます。

Sub OpenExcelFile()
    Dim wb As Workbook

    '~~> FilePath is the file that we earlier downloaded
    Set wb = Workbooks.Open(FilePath)
End Sub

この投稿を、 vba-excel のポイント 15、16、および 17 からアクセスできるいくつかのブログ投稿 (詳細な説明付き) に変換しました。

vba - Outlook から添付ファイルをダウンロードして Excel で開く

2 に答える 2

パート1

パート2

パート - 3

パート - 4

パート - 5

Related

Reference