Разделение отчета на отдельные электронные письма с их отдельными отчетами - PullRequest
Новая
       9

Разделение отчета на отдельные электронные письма с их отдельными отчетами

0 голосов
/ 14 февраля 2019

Я пытаюсь отправить отдельным сотрудникам PDF / страницу их раздела / отчета.Информация основана на их EmployeeID (это текст, а не длинный номер).Таким образом, у каждого человека есть информация о балансе на странице, затем разрыв страницы, а затем на следующей странице отображаются данные следующего человека.Используя приведенный ниже код, он отправляет каждому сотруднику по электронной почте одну страницу, но бывает так, что КАЖДЫЙ отправляет только страницу первого лица.Можно ли каким-то образом автоматизировать каждую неделю, чтобы каждый пользователь отправлял по электронной почте свою индивидуальную страницу отчета?

Другая ошибка заключается в том, что электронное письмо всплывает одно за другим, поэтому мне приходится нажимать кнопку отправить каждый раз200 человек, и, похоже, что электронная почта отправляется на электронную почту, но затем следует #mailto: электронная почта #, например, 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

Ответы [ 2 ]

0 голосов
/ 14 февраля 2019

Рассмотрите возможность использования библиотеки объектов 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
0 голосов
/ 14 февраля 2019

Вы открываете отчет с именем 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
...