Question

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

另一个错误是该电子邮件一个一个地弹出，因此我必须每次按200个以上的人发送，并且该电子邮件似乎正在发送到该电子邮件，但随后是例如#mailto：电子邮件＃ email@email.com#mailto：email@email.com＃

我刚刚启动Access，并且一直在从网上找到的地方复制和抓取代码。如果可以的话，请多谢！

祝你有美好的一天！

class TestFoo(unittest.TestCase):
    def test1(self):
        x=37
        a=foo.A(x)
        self.assertEqual(a.foo, 37)

Answer 1

您打开一个名为test的报告，然后关闭另一个名为“未确认的报告”的报告。您需要打开和关闭相同的报告，在本例中为“测试”。 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，然后附加到电子邮件以进行最终发送。有关详细信息，请参见嵌入式注释。

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

将报告分为单独的电子邮件和各自的报告

2 个答案: