Email 从任何电子邮件程序发送带有附件的电子邮件
我需要从MS Access数据库发送带有附件的电子邮件（不是Access对象，而是单独的文件），但不绑定到任何一个电子邮件软件（Groupwise、Outlook等）。我找到了使用Groupwise和Outlook发送带有附件的电子邮件的代码，还有一个通用的Email 从任何电子邮件程序发送带有附件的电子邮件,email,ms-access,email-attachments,Email,Ms Access,Email Attachments,我需要从MS Access数据库发送带有附件的电子邮件（不是Access对象，而是单独的文件），但不绑定到任何一个电子邮件软件（Groupwise、Outlook等）。我找到了使用Groupwise和Outlook发送带有附件的电子邮件的代码，还有一个通用的DoCmd.SendObject，它似乎只支持附加Access对象。无论用户PC上配置了什么样的电子邮件客户端，是否都可以通过Access发送带有附件的电子邮件 理由：这里的软件推出有一些复杂之处。我使用的机器已安装Access 2013和O
DoCmd.SendObject理由：这里的软件推出有一些复杂之处。我使用的机器已安装Access 2013和Outlook 2013。数据库的用户正在运行Access 2010，但当我在2013年将数据库编译成.accde时，它在2010年无法工作。我能让它工作的唯一方法是在运行Access 2010的旧电脑上编译它。但是，这台旧电脑没有Outlook，并且不会/无法在其上安装Outlook。这意味着我无法使用Outlook库编译数据库，因为机器上没有Outlook库。以下是我使用Gmail发送电子邮件的代码：
Public Function SendEmailViaGmail(SendTo As String, Optional Subject As String = "", Optional TextBody As String = "", Optional ReplyTo As String = "", Optional AttachedFiles As Variant = "") As String
On Error GoTo send_emailErr
Dim ErrNum As Long
Dim ErrDes As String
SendEmailViaGmail = ""
ErrNum = 0
Set cdomsg = CreateObject("CDO.message")
With cdomsg.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendusername '
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendpassword
.Update
End With
' build email parts
With cdomsg
.To = SendTo
.FROM = sendusername
.Subject = Subject
.TextBody = TextBody & vbCrLf & vbCrLf & vbCrLf & "--" & vbCrLf & "Sent using Marlan Data-Systems"
If IsArray(AttachedFiles) Then
For Each AttachedFile In AttachedFiles
If Len(AttachedFile) > 3 Then .AddAttachment AttachedFile
Next
Else
If Len(AttachedFiles) > 3 Then .AddAttachment AttachedFiles
End If
.send
End With
SendEmailViaGmail = "Done!"
send_emailExit:
Set cdomsg = Nothing
Exit Function
send_emailErr:
ErrNum = Err.Number
ErrDes = Err.Description
Select Case Err.Number
Case -2147220977 'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
SendEmailViaGmail = "Please Format the Email Address Correctly."
Case -2147220980 'Likely cause, No Recipient Provided (No Email Address)
SendEmailViaGmail = "Please Provide an Email Address"
Case -2147220960 'Likely cause, SendUsing Configuration Error
SendEmailViaGmail = "SendUsing Configuration Error"
Case -2147220973 'Likely cause, No Internet Connection
SendEmailViaGmail = "Please Check Internet Connection"
Case -2147220975 'Likely cause, Incorrect Password
SendEmailViaGmail = "Please Check Password"
Case Else 'Report Other Errors
SendEmailViaGmail = ""
End Select
SendEmailViaGmail = SendEmailViaGmail & " Error number: " & Err.Number & " Description: " & Err.Description
'If ErrNum = -2147220975 Then
' cdomsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465
' Resume
'End If
Resume send_emailExit
End Function
AttachedFilesCDO.message是Microsoft windows对象。
您可以将
smtpserver代码基于我在web上找到的代码。以下是我使用Gmail发送电子邮件的代码：
Public Function SendEmailViaGmail(SendTo As String, Optional Subject As String = "", Optional TextBody As String = "", Optional ReplyTo As String = "", Optional AttachedFiles As Variant = "") As String
On Error GoTo send_emailErr
Dim ErrNum As Long
Dim ErrDes As String
SendEmailViaGmail = ""
ErrNum = 0
Set cdomsg = CreateObject("CDO.message")
With cdomsg.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendusername '
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendpassword
.Update
End With
' build email parts
With cdomsg
.To = SendTo
.FROM = sendusername
.Subject = Subject
.TextBody = TextBody & vbCrLf & vbCrLf & vbCrLf & "--" & vbCrLf & "Sent using Marlan Data-Systems"
If IsArray(AttachedFiles) Then
For Each AttachedFile In AttachedFiles
If Len(AttachedFile) > 3 Then .AddAttachment AttachedFile
Next
Else
If Len(AttachedFiles) > 3 Then .AddAttachment AttachedFiles
End If
.send
End With
SendEmailViaGmail = "Done!"
send_emailExit:
Set cdomsg = Nothing
Exit Function
send_emailErr:
ErrNum = Err.Number
ErrDes = Err.Description
Select Case Err.Number
Case -2147220977 'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
SendEmailViaGmail = "Please Format the Email Address Correctly."
Case -2147220980 'Likely cause, No Recipient Provided (No Email Address)
SendEmailViaGmail = "Please Provide an Email Address"
Case -2147220960 'Likely cause, SendUsing Configuration Error
SendEmailViaGmail = "SendUsing Configuration Error"
Case -2147220973 'Likely cause, No Internet Connection
SendEmailViaGmail = "Please Check Internet Connection"
Case -2147220975 'Likely cause, Incorrect Password
SendEmailViaGmail = "Please Check Password"
Case Else 'Report Other Errors
SendEmailViaGmail = ""
End Select
SendEmailViaGmail = SendEmailViaGmail & " Error number: " & Err.Number & " Description: " & Err.Description
'If ErrNum = -2147220975 Then
' cdomsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465
' Resume
'End If
Resume send_emailExit
End Function
AttachedFilesCDO.message是Microsoft windows对象。
您可以将
smtpserver