从任何电子邮件程序发送带有附件的电子邮件

Posted 2023-05-06

【中文标题】从任何电子邮件程序发送带有附件的电子邮件

【英文标题】：Send email with attachment from any email program

【发布时间】：2016-05-31 09:42:15

【问题描述】：

我需要从 MS Access 数据库发送一封带有附件的电子邮件（不是 Access 对象，而是一个单独的文件），但不与任何电子邮件软件（Groupwise、Outlook 等）绑定）。我找到了使用 Groupwise 和 Outlook 发送带有附件的电子邮件的代码，并且有一个通用的 DoCmd.SendObject，它似乎只支持附加 Access 对象。有没有办法从 Access 发送带有附件的电子邮件，而不管用户 PC 上配置的电子邮件客户端如何？

理由：这里的软件推出存在复杂性。我工作的机器安装了 Access 2013 和 Outlook 2013。数据库的用户正在运行 Access 2010，但是当我在 2013 年将数据库编译成 .accde 时，它​​在 2010 年不起作用。我能让它工作的唯一方法是在一台同样运行的旧 PC 上编译它Access 2010。但是，这台旧 PC 没有 Outlook，IT 无法/无法在其上安装 Outlook。这意味着我无法使用 Outlook 库编译数据库，因为机器上没有 Outlook 库。

【参考方案1】：

这是我用来使用 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

AttachedFiles 是一个字符串或字符串数​​组，表示要附加到电子邮件的一个或多个文件的完整路径。CDO.message 是一个 Microsoft Windows 对象. 您可以将smtpserver 的值替换为其他一些邮件服务。如果这样做，请务必同时修改其他参数。 代码基于我在网上找到的代码。