web-dev-qa-db-fra.com

Excel VBA Code pour récupérer des e-mails à partir d'Outlook

Je dois écrire un code VBA qui récupèrerait les e-mails d'Outlook en fonction de certaines conditions. Le problème que j'ai est que je dois désigner un certain dossier dans mon code (dans l'exemple ci-dessous, le dossier indiqué est "PRE Costumer". Je voudrais récupérer tous les e-mails de ma "boîte de réception" ou, mieux, de tous les dossiers Outlook . Le problème est que ma boîte de réception se compose de nombreux sous-dossiers (en raison de règles0. Mon problème est que je ne connais peut-être pas tous les noms de sous-dossiers (car de nombreux utilisateurs vont utiliser la macro et même quelqu'un peut avoir les e-mails dans les dossiers personnels). .
Pourriez-vous indiquer s'il existe un moyen de surmonter ce problème?
Veuillez me faire savoir si cette question est vague (car je suis un nouveau venu)

Veuillez trouver la ligne avec laquelle j'ai un problème marqué d'un commentaire.

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
'Below is the line I have problem with
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("PRE Customer") 

i = 1
x = Date

For Each olMail In Fldr.Items
    If InStr(olMail.Subject, "transactions") > 0 _
    And InStr(olMail.ReceivedTime, x) > 0 Then  
        ActiveSheet.Cells(i, 1).Value = olMail.Subject
        ActiveSheet.Cells(i, 2).Value = olMail.ReceivedTime
        ActiveSheet.Cells(i, 3).Value = olMail.SenderName
        i = i + 1
    End If
Next olMail

Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
vbaexcel-vbaoutlook-vbaexcel
8
Artur Rutkowski

Parcourez simplement tous les dossiers de Inbox.
Quelque chose comme ça fonctionnerait.

Edit1: Cela évitera les lignes vides.

Sub test()
    Dim olApp As Outlook.Application, olNs As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder, olMail As Outlook.MailItem
    Dim eFolder As Outlook.Folder '~~> additional declaration
    Dim i As Long
    Dim x As Date, ws As Worksheet '~~> declare WS variable instead
    Dim lrow As Long '~~> additional declaration

    Set ws = Activesheet '~~> or you can be more explicit using the next line
    'Set ws = Thisworkbook.Sheets("YourTargetSheet")
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    x = Date

    For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
        'Debug.Print eFolder.Name
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.Name)
        For i = olFolder.Items.Count To 1 Step -1
            If TypeOf olFolder.Items(i) Is MailItem Then
                Set olMail = olFolder.Items(i)
                If InStr(olMail.Subject, "transactions") > 0 _
                And InStr(olMail.ReceivedTime, x) > 0 Then
                    With ws
                       lrow = .Range("A" & .Rows.Count).End(xlup).Row
                       .Range("A" & lrow).Offset(1,0).value = olMail.Subject
                       .Range("A" & lrow).Offset(1,1).Value = olMail.ReceivedTime
                       .Range("A" & lrow).Offset(1,2).Value = olMail.SenderName
                    End With
                End If
            End If
        Next i
        Set olFolder = Nothing
    Next eFolder
End Sub

Ci-dessus prend en charge tous les sous-dossiers dans Inbox.
C'est ce que vous essayez?

12
L42