发送带有附件的电子邮件VBA

本文介绍了发送带有附件的电子邮件VBA的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

我正在尝试在电子邮件中添加附件功能.我的电子邮件代码正常工作，但是附件以ATT00001.bin文件的形式发送.

I am trying to add an attachment functionality to my emails. My email code is working however the attachments are being sent as ATT00001.bin files.

变量Forms！[frmMain]！TabCtl54.Pages("page56").Controls("subtblcontent").Form！[attachmentlnk]是表单上的文本框，我将在其中放置文件名.

The variable Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] is a textbox on a form which is where I would put my file name.

attachmentlnkvar = "file:///C:/Users/desktopname/Desktop/" & Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] & ".pdf" With cdomsg .To = emailstr .FROM = fromemailstr .subject = Forms!frmMain.txtSubject .Attachments.Add attachmentlnkvar .HTMLBody = strHTML .Send End With Set cdomsg = Nothing

有没有办法将我的文件以pdf格式发送?

Is there a way I can send my files as pdfs?

推荐答案

我很高兴与您分享我用来发送所有电子邮件的功能:

I am happy to share with you the function which I use to sent all my emails:

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 www.microsoft/office" & _ "/previous/outlook/downloads/security.asp. " Else Call LogError(Err.Number, Err.Description, "SystemUtilities", "SendMessage") Resume Next Resume End If End Sub

变量AttachmentPath可以包含多个以;"分隔的附件路径.

The variable AttachmentPath can contain multiple paths to attachments delimited by ";"