Public Function SendMail(strFrom As String, strTo As String, _
strCC As String, _
strBCC As String, _
strSubject As String, _
strBody As String, _
strFilename As String _
) As Boolean
Dim oOutlookApp    As New Outlook.Application
Dim oItemMail    As Outlook.MailItem
Set oItemMail = oOutlookApp.CreateItem(olMailItem)
On Error GoTo errHandle
If Len(Trim(strFilename)) = 0 Then
With oItemMail
'.Recipients
.SentOnBehalfOfName = strFrom
.To = strTo
.CC = strCC
.BCC = strBCC
.Subject = strSubject
.Body = strBody
'.Attachments.Add (strFilename)
.Importance = olImportanceHigh
.
Sensitivity = olPersonal
.Send
End With
Else
With oItemMail
'.Recipients
.SentOnBehalfOfName = strFrom
.To = strTo
.CC = strCC
.BCC = strBCC
.Subject = strSubject
.
Body = strBody
.Attachments.Add (strFilename)
.Importance = olImportanceHigh
.Sensitivity = olPersonal
.Send
End With
End If
SendMail = True
Exit Function
errHandle:
SendMail = False
End Function
Public Function CheckMail(strFrom As String, strTo As String, _
strCC As String, _
strBCC As String, _
strSubject As String, _
strBody As String, _
strFilename As String _
) As Boolean
Dim oOutlookApp  As New Outlook.Application
Dim oItemMail    As Outlook.MailItem
Set oItemMail = oOutlookApp.CreateItem(olMailItem)
On Error GoTo errHandle
If Len(Trim(strFilename)) = 0 Then
With oItemMail
'.Recipients
.SentOnBehalfOfName = strFrom
.To = strTo
.CC = strCC
.BCC = strBCC
.Subject = strSubject
.Body = strBody
'.Attachments.Add (strFilename)
.
Importance
= olImportanceHigh
.Sensitivity = olPersonal
'                    .Display
.Save
End With
Else
With oItemMail
'.Recipients
.SentOnBehalfOfName = strFrom
.To = strTo
.
CC = strCC
.BCC = strBCC
.Subject = strSubject
.Body = strBody
.Attachments.Add (strFilename)
.Importance = olImportanceHigh
.Sensitivity = olPersonal
'                  .Display
.Save
End With
End If
CheckMail = True
Exit Function
errHandle:
CheckMail = False
End Function
Sub SendMailNow()
Dim ExcelSheet As Object
Dim rowCount As Integer
Dim i As Integer
Set ExcelSheet = CreateObject("c:\email.xls")
rowCount = ExcelSheet.sheets(1).UsedRange.Rows.Count
For i = 2 To rowCount
SendMail strFrom:=ExcelSheet.sheets(1).cells(i, 1), strTo:=ExcelSheet.sheets(1).cells(i, 2), _
strCC:=ExcelSheet.sheets(1).cells(i, 3), strBCC:=ExcelSheet.sheets(1).cells(i, 4), _
strSubject:=ExcelSheet.sheets(1).cells(i, 5), strBody:=ExcelSheet.sheets(1).cells(i, 6), _
strFilename:=ExcelSheet.sheets(1).cells(i, 7)
Next i
ExcelSheet.Close False
Set ExcelSheet = Nothing
End Sub
邮件发Sub CheckMailNow()
aa = Timer
Dim ExcelSheet As Object
Dim rowCount As Integer
Dim i As Integer
Set ExcelSheet = CreateObject("c:\email.xls")
rowCount = ExcelSheet.sheets(1).UsedRange.Rows.Count
For i = 2 To rowCount
CheckMail strFrom:=ExcelSheet.sheets(1).cells(i, 1), strTo:=ExcelSheet.sheets(1).cells(i, 2), _
strCC:=ExcelSheet.sheets(1).cells(i, 3), strBCC:=ExcelSheet.sheets(1).cells(i, 4), _
strSubject:=ExcelSheet.sheets(1).cells(i, 5), strBody:=ExcelSheet.sheets(1).cells(i, 6), _
strFilename:=ExcelSheet.sheets(1).cells(i, 7)
Next i
ExcelSheet.Close False
Set ExcelSheet = Nothing
MsgBox "Total Time :=  " & Format(Timer - aa, "0.00") & "s"
End Sub