下面的两个示例宏演示了如何将信息发送到Outlook(例如,发送电子邮件)以及如何从Outlook中检索信息(例如,检索收件箱中所有邮件的列表)。

注意!在尝试在自己的项目中执行代码之前,请阅读并编辑示例代码!

' 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