Question

我正在尝试通过点击命令按钮向提交表单发送电子邮件。我已经创建了基于4个主键过滤表单的代码。但是当我运行代码时，FleetID部分在立即窗格中拉出空白。 FleetID部分以组合框的形式提供。有人可以帮帮我吗？

由于

On Error GoTo errhandle
    Me.Filter = "CurrentDate= #" & Format(Me!CurrentDate, "yyyy\-mm\-dd") & "# and DiscoverTime= '" & Me!DiscoverTime & "' And TailNumber= '" & Me!TailNumber & "' And FleetID= '" & Me!FleetID & "'"
    Debug.Print Me.Filter
    Me.FilterOn = True
    DoCmd.SendObject acSendForm, "frmETIC",  acFormatPDF, "EMAIL", "", "", "Recovery Report", "Attached is the submitted Recovery Report"

exiterr:
    Exit Sub
errhandle:
    If Err.Number <> 2501 Then
        MsgBox ("Email cancelled!")
    End If
Resume exiterr

Answer 1

除了我在评论部分的建议。我个人会根据该查询创建一个查询和一个所需的报告。报告为您提供了非常整洁和专业的外观，与其他控件不同。

首先创建一个与表单数据源相同的查询
从该查询中创建报告。使用您的徽标页脚以及您希望获得打印边距的所有其他内容来设计报表。
根据条件生成报告并使用 docmd.sendobject

<强>替代地

使用您的where条件生成隐藏的报告
使用 docmd.outputTo
创建新的Outlook电子邮件对象并附加PDF文件

两种方式都有各自的优势。我个人使用第二个，因为我更容易自定义电子邮件内容/模板。

以下是创建电子邮件的功能：

Function SEND_EMAIL_MESSAGE(mTo As String, mCC As String, mBC As String, mSubject As String, mBody As String, Optional useOwnSignature As Boolean = False, Optional DisplayMsg As Boolean = False, Optional isHTML As Boolean = False, Optional AttachmentPath = "") As Boolean
' Please check the reference for Microsoft Outlook 14.0 object library for outlook 2010.

    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookAttach As Outlook.Attachment
    Dim mSignature As String

    On Error GoTo ERROR_EMAIL
    ' Create the Outlook session.
    Set objOutlook = New Outlook.Application

    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    With objOutlookMsg
        ' Add the To recipient(s) to the message.
        .To = mTo
        .CC = mCC
        .BCC = mBC
        .Subject = mSubject

        If useOwnSignature Then .BodyFormat = olFormatHTML
        .Display

        If useOwnSignature Then
            If isHTML Then

                mSignature = .HTMLBody
                .HTMLBody = mBody & mSignature
            Else
                mSignature = .Body
                .Body = mBody & mSignature
            End If
        Else
            .Body = mBody
        End If

        ' Add attachments to the message.
        If Not IsMissing(AttachmentPath) Then
            Dim mFiles() As String
            If (VBA.Right(AttachmentPath, 1)) <> ";" Then AttachmentPath = AttachmentPath & ";"
            mFiles = VBA.Split(AttachmentPath, ";")
            Dim i As Integer
            For i = 0 To UBound(mFiles) - 1
                If Not mFiles(i) = "" Then Set objOutlookAttach = .Attachments.Add(mFiles(i))
            Next i

        End If

        ' Should we display the message before sending?
        If DisplayMsg Then
            .Display
        Else
            .Send
        End If
    End With

    SEND_EMAIL_MESSAGE = True
EXIT_ROUTINE:
    On Error GoTo 0
    Set objOutlook = Nothing
    Set objOutlookMsg = Nothing
    Exit Function

ERROR_EMAIL:
    SEND_EMAIL_MESSAGE = False
    GoTo EXIT_ROUTINE
End Function

您在这里可以生成报告并发送到电子邮件的代码：

strReportName = "rpt_incident_view_single"

        DoCmd.OpenReport strReportName, acViewPreview, , strCriteria, acHidden

        Dim tmpPath As String
        tmpPath = VBA.Environ("temp")
        strMyPath = tmpPath
        If VBA.Right(strMyPath, 1) = "\" Then
            strMyPath = strMyPath & "_" & incident_id & "_" & VBA.Format(Now, "yyyy-dd-mm") & ".pdf"
        Else
            strMyPath = strMyPath & "\" & "_" & incident_id & "_" & VBA.Format(Now, "dd-mm-yyyy") & ".pdf"
        End If

        DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, strMyPath, False

保存报告后，只需将其发送到电子邮件功能，该功能将创建新电子邮件并将其显示给用户：

SEND_EMAIL_MESSAGE mTo, mCC, mBcc, mSubject, mBody,,,, strMyPath
DoCmd.Close acReport, strReportName
on error resume next
VBA.Kill strMyPath

根据您的需要修改代码。祝你好运：）

来自Access的PDF电子邮件

1 个答案: