1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
| Sub getDataFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim objOwner As Outlook.Recipient
Dim i As Integer
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set objOwner = OutlookNamespace.CreateRecipient("xxxxxxxxxx")
objOwner.Resolve
If objOwner.Resolved Then
Set Folder = OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
Set Folder = Folder.Folders("yyyyyyyyyy")
End If
i = 1
For Each OutlookMail In Folder.Items
If TypeOf OutlookMail Is MailItem Then
If CDate(OutlookMail.ReceivedTime) >= Range("email_ReceiptDate").Value Then
If CDate(OutlookMail.ReceivedTime) <= Range("email_ReceiptDate2").Value Then
Range("email_Date").Offset(i, 0) = OutlookMail.ReceivedTime
Range("email_Sender").Offset(i, 0) = OutlookMail.SenderName
Range("email_Subject").Offset(i, 0) = OutlookMail.Subject
i = i + 1
End If
End If
End If
Next OutlookMail
MsgBox "Export complete", vbInformation
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub |
Partager