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

Question

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

1. ダウンロード Outlook受信ボックスの最初の電子メール（最新の電子メール）からの唯一の添付ファイル
2. 保存指定されたパスを持つファイルの添付ファイル（例： "C：..."）
3. 添付ファイルの名前を次のように変更します。現在の日付 + 以前のファイル名
4. 「C：...」などのパスを持つ別のフォルダーにメールを保存します
5. Outlookでメールを「既読」としてマークする
6. 開く ExcelのExcel添付ファイル

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

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

ただし、これは別の質問で尋ねる方が良いかもしれませんが、自分で調べてください。

私が現在持っているコードは他のオンラインフォーラムからのもので、おそらくあまり役​​に立たないでしょう。ただし、ここで私が取り組んできた細かな部分をいくつか示します。

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

Answer 1

完全なコードを一度に提供することはできますが、それから学習することはできません;）それで、リクエストを分割してみましょう。それから1 x 1に取り組みます。 ）

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

---

パート1

1. Outlookへの接続の作成
2. 未読のメールがあるかどうかを確認する
3. Sender email Address、Date received、Date Sent、Subject、The 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

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

1. Outlook受信ボックスの最初のメール（最新のメール）から唯一の添付ファイルをダウンロードします
2. 指定したパス（例： "C：..."）でファイルに添付ファイルを保存します
3. 添付ファイル名を現在の日付+以前のファイル名に変更します

このコード例を参照してください。私は再び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

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

1. 「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

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

1. 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

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

1. ExcelでExcel添付ファイルを開く

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

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からアクセスできるいくつかのブログ投稿（詳細な説明付き）にこの投稿を変換しました。

Answer 2

(Excel vba)

コードに感謝します:)あなたのコード（コードを盗まれました）..私は今日この状況がありました。ここに私のコードがあります。コードは添付ファイルを保存し、メール情報も保存します。シド

Tested 

Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String

Const num As Integer = 6
Const path As String = "C:\HP\"
Const emailpath As String = "C:\Dell\"
Const olFolderInbox As Integer = 6

Set olp = CreateObject("Outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)

If olmail.items.restrict("[UNREAD]=True").Count = 0 Then

    MsgBox ("No Unread mails")

    Else

        For Each olitem In olmail.items.restrict("[UNREAD]=True")
            lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

            Range("A" & lrow).Value = olitem.Subject
            Range("B" & lrow).Value = olitem.senderemailaddress
            Range("C" & lrow).Value = olitem.to
            Range("D" & lrow).Value = olitem.cc
            Range("E" & lrow).Value = olitem.body

            If olitem.attachments.Count <> 0 Then

                For Each olattach In olitem.attachments

                    olattach.SaveAsFile path & Format(Date, "MM-dd-yyyy") & olattach.Filename

                Next olattach

            End If
    str = olitem.Subject
    str = Replace(str, "/", "-")
    str = Replace(str, "|", "_")
    Debug.Print str
            olitem.SaveAs (emailpath & str & ".msg")
            olitem.unread = False
            DoEvents
            olitem.Save
        Next olitem

End If

ActiveSheet.Rows.WrapText = False

End Sub