Télécharger la pièce jointe à partir d'Outlook et ouvrir dans Excel

Question

J'essaie de télécharger puis d'ouvrir une pièce jointe de feuille de calcul Excel dans un e-mail Outlook à l'aide de VBA dans Excel. Comment puis-je:

1. Télécharger la seule et unique pièce jointe du premier e-mail (le plus récent e-mail) dans ma boîte de réception Outlook
2. Enregistrer la pièce jointe dans un fichier avec un chemin spécifié (par exemple: "C: ...")
3. Renommez le nom de la pièce jointe avec: date actuelle + nom de fichier précédent
4. Enregistrez l'e-mail dans un dossier différent avec un chemin d'accès tel que "C: ..."
5. Marquer l'e-mail dans Outlook comme "lu"
6. Ouvrir la pièce jointe Excel dans Excel

Je souhaite également pouvoir enregistrer les éléments suivants en tant que chaînes individuelles affectées à des variables individuelles:

• Adresse e-mail de l'expéditeur
• Date de réception
• Date d'envoi
• Subject
• Le message de l'email

bien que ce soit mieux de demander dans une question séparée/chercher moi-même.

Le code que j'ai actuellement provient d'autres forums en ligne et n'est probablement pas très utile. Cependant, voici quelques morceaux sur lesquels j'ai travaillé:

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

Je peux vous donner le code complet en une seule fois, mais cela ne vous aiderait pas à en tirer des leçons;) Alors, décomposons vos demandes et nous les aborderons 1 par 1. Cela va être un très long post alors soyez patient: )

Il y a un total de 5 parties qui couvriront les 7 points (oui 7 et pas 6) afin que vous n'ayez pas à créer une nouvelle question pour votre 7ème point.

---

PARTIE 1

1. Création d'une connexion à Outlook
2. Vérifier s'il y a des e-mails non lus
3. Récupération de détails tels que Sender email Address, Date received, Date Sent, Subject, The message of the email

Voir cet exemple de code. Je me lie tardivement à Outlook à partir d'Excel, puis je vérifie s'il y a des éléments non lus et s'il y en a, je récupère les détails pertinents.

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

Alors prenez soin de votre demande qui parle de stocker des détails dans les variables.

---

PARTIE 2

Passons maintenant à votre prochaine demande

1. Téléchargez la seule et unique pièce jointe du premier e-mail (le dernier e-mail) dans ma boîte de réception Outlook
2. Enregistrez la pièce jointe dans un fichier avec un chemin d'accès spécifié (par exemple: "C: ...")
3. Renommez le nom de la pièce jointe avec: date actuelle + nom de fichier précédent

Voir cet exemple de code. Je suis à nouveau en retard avec Outlook à partir d'Excel, puis je vérifie s'il y a des éléments non lus et s'il y en a, je vérifie en outre s'il contient une pièce jointe et s'il l'a ensuite téléchargée dans le dossier correspondant.

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

---

PARTIE - 3

Passer à votre prochaine demande

1. Enregistrez l'e-mail dans un dossier différent avec un chemin d'accès tel que "C: ..."

Voir cet exemple de code. Cela enregistre l'e-mail pour dire 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

---

PARTIE - 4

Passer à votre prochaine demande

1. Marquer l'e-mail dans Outlook comme "lu"

Voir cet exemple de code. Cela marquera l'e-mail comme 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

---

PARTIE - 5

Passer à votre prochaine demande

1. Ouvrez la pièce jointe Excel dans Excel

une fois que vous avez téléchargé le fichier/pièce jointe comme indiqué ci-dessus, utilisez ce chemin dans le code ci-dessous pour ouvrir le fichier.

Sub OpenExcelFile()
    Dim wb As Workbook

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

J'ai converti cet article en plusieurs articles de blog (avec plus d'explications) accessibles via les points 15, 16 et 17 dans vba-Excel

Answer 2

(Excel vba)

Merci à Sid :) pour votre code (volé votre code) .. j'ai eu cette situation aujourd'hui. Voici mon code. Sid

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