Contrôle Outlook à partir d’Excel à l’aide VBA dans Microsoft Excel
Les deux exemples de macros ci-dessous montrent comment envoyer des informations à Outlook (par exemple, envoyer un message électronique) et comment récupérer des informations à partir d’Outlook (par exemple, récupérer une liste de tous les messages de la boîte de réception).
Remarque! Lisez et modifiez l’exemple de code avant d’essayer de l’exécuter dans votre propre projet!
' requires a reference to the Microsoft Outlook 8.0 Object Library Sub SendAnEmailWithOutlook() ' creates and sends a new e-mail message with Outlook Dim OLF As Outlook.MAPIFolder, olMailItem As Outlook.MailItem Dim ToContact As Outlook.Recipient Set OLF = GetObject("", _ "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) Set olMailItem = OLF.Items.Add ' creates a new e-mail message With olMailItem .Subject = "Subject for the new e-mail message" ' message subject Set ToContact = .Recipients.Add("[email protected]") ' add a recipient Set ToContact = .Recipients.Add("[email protected]") ' add a recipient ToContact.Type = olCC ' set latest recipient as CC Set ToContact = .Recipients.Add("[email protected]") ' add a recipient ToContact.Type = olBCC ' set latest recipient as BCC .Body = "This is the message text" & Chr(13) ' the message text with a line break .Attachments.Add "C:\FolderName\Filename.txt", olByValue, , _ "Attachment" ' insert attachment ' .Attachments.Add "C:\FolderName\Filename.txt", olByReference, , _ "Shortcut to Attachment" ' insert shortcut ' .Attachments.Add "C:\FolderName\Filename.txt", olEmbeddedItem, , _ "Embedded Attachment" ' embedded attachment ' .Attachments.Add "C:\FolderName\Filename.txt", olOLE, , _ "OLE Attachment" ' OLE attachment .OriginatorDeliveryReportRequested = True ' delivery confirmation .ReadReceiptRequested = True ' read confirmation '.Save ' saves the message for later editing .Send ' sends the e-mail message (puts it in the Outbox) End With Set ToContact = Nothing Set olMailItem = Nothing Set OLF = Nothing End Sub Sub ListAllItemsInInbox() Dim OLF As Outlook.MAPIFolder, CurrUser As String Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer Application.ScreenUpdating = False Workbooks.Add ' create a new workbook ' add headings Cells(1, 1).Formula = "Subject" Cells(1, 2).Formula = "Recieved" Cells(1, 3).Formula = "Attachments" Cells(1, 4).Formula = "Read" With Range("A1:D1").Font .Bold = True .Size = 14 End With Application.Calculation = xlCalculationManual Set OLF = GetObject("", _ "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) EmailItemCount = OLF.Items.Count i = 0: EmailCount = 0 ' read e-mail information While i < EmailItemCount i = i + 1 If i Mod 50 = 0 Then Application.StatusBar = "Reading e-mail messages " & _ Format(i / EmailItemCount, "0%") & "..." With OLF.Items(i) EmailCount = EmailCount + 1 Cells(EmailCount + 1, 1).Formula = .Subject Cells(EmailCount + 1, 2).Formula = Format(.ReceivedTime, "dd.mm.yyyy hh:mm") Cells(EmailCount + 1, 3).Formula = .Attachments.Count Cells(EmailCount + 1, 4).Formula = Not .UnRead End With Wend Application.Calculation = xlCalculationAutomatic Set OLF = Nothing Columns("A:D").AutoFit Range("A2").Select ActiveWindow.FreezePanes = True ActiveWorkbook.Saved = True Application.StatusBar = False End Sub