Điều khiển Outlook từ Excel bằng VBA trong Microsoft Excel
Hai macro ví dụ bên dưới minh họa cách bạn có thể gửi thông tin đến Outlook (ví dụ: gửi thư e-mail) và cách bạn có thể truy xuất thông tin từ Outlook (ví dụ: truy xuất danh sách av tất cả thư trong Hộp thư đến).
Ghi chú! Đọc và chỉnh sửa mã ví dụ trước khi bạn cố gắng thực thi nó trong dự án của riêng bạn!
' 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