Excel.VBA.实战技巧精粹.源码

Sub SendTest() SendMail "xfwen1973@gmail.com", "xfwen@21cn.com", "hello", _ "test auto send email", "d:\try.txt" End Sub Public Sub SendMail1、(strTo As String, strCC As String, strSubject _ As String, strBody As String, Optional strAttach As String) Dim otlk As Outlook.Application Dim mailitem As Outlook.mailitem On Error GoTo errHandle Set otlk = New Outlook.Application Set mailitem = otlk.CreateItem(olMailItem) With mailitem .To = strTo .CC = strCC .Importance = olImportanceHigh .Subject = strSubject .Body = strBody If Len(strAttach) <> 0 Then .Attachments.Add strAttach .Send End With Do Until mailitem.Sent = True DoEvents Loop errHandle: otlk.Quit Set otlk = Nothing End Sub Sub ListAllFolders(objFolder As Outlook.MAPIFolder) Dim mItem As Outlook.mailitem Dim objSubFolder As Outlook.MAPIFolder Dim strSub As String, strSender As String Dim strCC As String, strBody As String For Each mItem In objFolder.Items If mItem.UnRead = True Then strSub = mItem.Subject strSender = mItem.SenderEmailAddress strCC = mItem.CC strBody = mItem.HTMLBody MsgBox "发送者：" & strSender & vbCrLf _ & "CC：" & strCC & vbCrLf _ & "主题：" & strSub & vbCrLf _ & "主体：" & strBody End If Next For Each objSubFolder In objFolder.Folders ListAllFolders objSubFolder Next Set mItem = Nothing End Sub Sub ListUnReadMail() Dim otlk As Outlook.Application Dim nmspc As Outlook.Namespace Dim mlItem As Outlook.mailitem Dim objFolder As Outlook.MAPIFolder On Error GoTo errHandle Set otlk = New Outlook.Application Set nmspc = otlk.GetNamespace("MAPI") Set objFolder = nmspc.GetDefaultFolder(olFolderInbox) ListAllFolders objFolder errHandle: otlk.Quit Set otlk = Nothing Set nmspc = Nothing Set objFolder = Nothing End Sub