The two example macros below demonstrates how you can send information to Outlook
(e.g. sending an e-mail message) and how you can retrieve information from Outlook
(e.g. retrieving a list av all messages in the Inbox).
Note! Read and edit the example code before you try to execute it in your own project!
' 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("name@domain.com") ' add a recipient Set ToContact = .Recipients.Add("name@company.com") ' add a recipient ToContact.Type = olCC ' set latest recipient as CC Set ToContact = .Recipients.Add("name@org.net") ' 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
The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.
Excellent, worked great, thanks!