将报告拆分为单独的电子邮件及其各自的报告

Question

我正在尝试向单独的员工发送其部分/报告的 PDF/页面。该信息基于他们的 EmployeeID（不是长数字的文本）。所以每个人在一个页面上都有他们的余额信息，然后有一个分页符，然后下一页显示下一个人的详细信息。使用下面的代码，它会向每个员工发送一个页面，但碰巧只将第一个人的页面发送给每个人。是否有可能每周以某种方式自动化，以便通过电子邮件向每个用户发送他/她单独的报告页面？

另一个错误是电子邮件一个接一个弹出，所以我必须为超过 200 人每次按发送，并且电子邮件似乎正在发送到电子邮件但随后是 #mailto:the email# 例如email@email.com#mailto:email@email.com#

我刚刚启动 Access，并且一直在从网上找到的地方复制和抓取代码。非常感谢您，如果您能提供帮助！

祝你有美好的一天！

Private Sub cmdSendAll_Click()

Dim rsAccountNumber As DAO.Recordset
Dim strTo As Variant
Dim strSubject As String
Dim strMessageText As String

Set rsAccountNumber = CurrentDb.OpenRecordset("SELECT DISTINCT EmployeeID, [Email] FROM [queAutoUpdate]", dbOpenSnapshot)

Debug.Print strTo

With rsAccountNumber

Do Until .EOF

DoCmd.OpenReport "test", _
acViewPreview, _
WhereCondition:="EmployeeID = '" & !EmployeeID & "'", _
WindowMode:=acHidden

strTo = ![Email]
strSubject = "Updated Balance "
strMessageText = "Text Here"


DoCmd.SendObject ObjectType:=acSendReport, _
ObjectName:="test", _
OutputFormat:=acFormatPDF, _
To:=strTo, _
Subject:=strSubject, _
MESSAGETEXT:=strMessageText, _
EditMessage:=True


DoCmd.Close acReport, "Unaffirmed Report", acSaveNo


.MoveNext

Loop

.Close

End With
End Sub

Answer 1

您打开了一个名为 test 的报告，然后关闭了另一个名为“Unaffirmed Report”的报告。您需要打开和关闭同一个报告，在本例中为“测试”。 DoCmd.Close acReport, "test", acSaveNo。这应该可以解决员工数据未更新的问题，因为报告在第一个员工上保持打开状态。

要直接发送消息，您需要将EditMessage:=True 更改为EditMessage:=False。 检查文档： https://docs.microsoft.com/en-us/office/vba/api/access.docmd.sendobject

此外，如果您需要对此进行测试，将 Outlook 设置为离线模式并运行您的代码，请检查您的发件箱中的消息，看看它们是否符合预期。您可以从发件箱中删除邮件以防止它们被发送。完成测试后，您可以将 Outlook 设置回联机模式。

关于电子邮件地址问题，在您的控件中使用超链接时会自动出现此问题。你需要用strTo = Left(![Email],InStr(![Email],"#")-1) 去掉多余的部分。如果这对所有电子邮件地址都有效，请检查您的数据。如需更高级的解决方案，您可以查看此帖子https://codekabinett.com/rdumps.php?Lang=2&targetDoc=access-hyperlink-data-type。

提供的代码作为参考，解释请看帖子。

'copied from https://codekabinett.com/rdumps.php?Lang=2&targetDoc=access-hyperlink-data-type

Public Function GetHyperlinkFullAddress(ByVal hyperlinkData As Variant, Optional ByVal removeMailto As Boolean) As Variant

    Const SEPARATOR As String = "#"

    Dim retVal As Variant
    Dim tmpArr As Variant

    If IsNull(hyperlinkData) Then
        retVal = hyperlinkData
    Else

        If InStr(hyperlinkData, SEPARATOR) > 0 Then
            ' I append 4 separators at the end, so I don't have to worry about the
            ' lenght of the array returned by Split()
            hyperlinkData = hyperlinkData & String(4, SEPARATOR)
            tmpArr = Split(hyperlinkData, SEPARATOR)

            If Len(tmpArr(1)) > 0 Then
                retVal = tmpArr(1)
                If Len(tmpArr(2)) > 0 Then
                    retVal = retVal & "#" & tmpArr(2)
                End If
            End If
        Else
            retVal = hyperlinkData
        End If

        If Left(retVal, 7) = "mailto:" Then
            retVal = Mid(retVal, 8)
        End If

    End If

    GetHyperlinkFullAddress = retVal

End Function

Answer 2

考虑使用 MS Outlook 对象库发送电子邮件。 DoCmd.SendObject 是一个便利的处理程序，而您可以通过初始化 Outlook 应用程序对象和创建 Outlook 电子邮件对象来设置所有需要的元素来控制更多过程。

但是，使用这种方法，您需要先将过滤后的报告导出为 PDF，然后附加到电子邮件以进行最终发送。有关具体细节，请参阅内联 cmets。

Dim rsAccountNumber As DAO.Recordset
' CHECK Microsoft Outlook #.# Object Library UNDER Tools/References
Dim olApp As Outlook.Application, olEmail As Outlook.MailItem
Dim fileName As string, todayDate As String, strEmail As String    

todayDate = Format(Date, "YYYY-MM-DD")

Set rsAccountNumber = CurrentDb.OpenRecordset("SELECT DISTINCT EmployeeID, [Email] FROM [queAutoUpdate]", dbOpenSnapshot)
Set olApp = New Outlook.Application

With rsAccountNumber
     Do Until .EOF
         ' SETTING FILE NAME TO SAME PATH AS DATABASE (ADJUST AS NEEDED)
         fileName = Application.CurrentProject.Path & "\Balance_Report_" & !EmployeeID & "_" & todayDate & ".pdf"

         ' OPEN AND EXPORT PDF TO FILE 
         DoCmd.OpenReport "test", acViewPreview, "EmployeeID = '" & !EmployeeID & "'"
         ' INTENTIONALLY LEAVE REPORT NAME BLANK FOR ABOVE FILTERED REPORT
         DoCmd.OutputTo acReport, , acFormatPDF, fileName, False
         DoCmd.Close acReport, "test" 

         ' CREATE EMAIL OBJECT
         strEmail = ![Email]
         Set olEmail = olApp.CreateItem(olMailItem)
         With olEmail
             .Recipients.Add strEmail
             .Subject = "Updated Balance"
             .Body = "Text Here"
             .Attachments.Add fileName           ' ATTACH PDF REPORT
             .Send                               ' SEND WITHOUT DISPLAY TO SCREEN
         End With 

         Set olEmail = Nothing
         .MoveNext
     Loop
     .Close
End With

MsgBox "All emails successfully sent!", vbInformation, "EMAIL STATUS"

Set rsAccountNumber = Nothing: Set olApp = Nothing