我很高兴与您分享我用来发送所有电子邮件的函数:
Public Sub SendMessage(Optional SubjectText = "", Optional BodyText = "", Optional AttachmentPath = "", Optional sendTo = "", Optional sendCC = "", Optional DeliveryConfirmation = True, Optional DisplayDoNotAutoSend = True, Optional SendHighPriority = True, Optional UseHTML = True)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim MultipleAttachmentPath As String
Dim CurrentAttachment As Variant
Dim aAtachments() As String
On Error GoTo ErrorMsgs
DoCmd.Hourglass True
' Create the Outlook session.
Set objOutlook = New Outlook.Application
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
If UseHTML Then
.BodyFormat = olFormatHTML
End If
If Not isnull(sendTo) And InStr(sendTo, "@") > 0 Then
.To = sendTo
End If
If Not isnull(sendCC) And InStr(sendCC, "@") > 0 Then
.CC = sendCC
End If
.Subject = SubjectText
If UseHTML Then
.HTMLBody = "<div style='font-family:Calibri,sans-serif'>" & BodyText & GetThankYouSignature & "</div>"
Else
.Body = BodyText & vbCrLf & GetUserFullNameInASCIIText & vbCrLf & vbCrLf
End If
If SendHighPriority Then
.Importance = olImportanceHigh 'High importance
End If
If DeliveryConfirmation Then
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
End If
On Error Resume Next
If AttachmentPath <> "" Then
' Add attachments to the message.
If Not IsMissing(AttachmentPath) And InStr(AttachmentPath, ";") = 0 Then
Set objOutlookAttach = .Attachments.add(AttachmentPath)
ElseIf Not IsMissing(AttachmentPath) And InStr(AttachmentPath, ";") > 0 Then
aAtachments = Split(AttachmentPath, ";")
For Each CurrentAttachment In aAtachments
.Attachments.add (CurrentAttachment)
Next
End If
End If
On Error GoTo ErrorMsgs
End With
If DisplayDoNotAutoSend Or isnull(sendTo) Then
objOutlookMsg.Display
Else
objOutlookMsg.Send
End If
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
DoCmd.Hourglass False
Exit Sub
ErrorMsgs:
DoCmd.Hourglass False
If Err.Number = "287" Then
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information," & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "
Else
Call LogError(Err.Number, Err.Description, "SystemUtilities", "SendMessage")
Resume Next
Resume
End If
End Sub
变量 AttachmentPath 可能包含多个用 ";" 分隔的附件路径。
attachmentlnkvar
被填充后,在with
之前的那一行,它的值是多少? - Nathan_Sav