Как отсортировать отчет и отправить электронное письмо каждому получателю с его правильными значениями ключа? - PullRequest
Новая
       1

Как отсортировать отчет и отправить электронное письмо каждому получателю с его правильными значениями ключа?

0 голосов
/ 23 октября 2019

У меня есть список менеджеров и их клиентов на листе «publico».

Мне нужно отправить отчет каждому менеджеру с их клиентами в теле письма.

Например: менеджер «ag1126ct18@teste.com» получит строки 2 и 3 из листа «publico».

Список прилагается здесь: https://drive.google.com/file/d/1jLkrWqZY9s2Kt2vy_cIMMRAd1H5iDCzg/view?usp=sharing

У меня есть несколькофункциональный код, который проходит через таблицу и отправляет электронные письма менеджерам, но каждый раз отправляет одно электронное письмо, если находит менеджера, и повторяет электронное письмо каждый раз, когда находит одно и то же электронное письмо.

Другойпроблема в том, что до сих пор код не добавляет строки в теле письма (не могу понять, как это сделать). 


  Dim dictMails As Object, k, rw
  Dim OutlookApp As Object
  Dim cell As Range
  Dim corpodoemail As String
  Dim AssuntoEmail As String
  Dim contator As Integer

  contador = 1

  Set OutlookApp = CreateObject("Outlook.Application")

  'Agrupa as linhas correlatas por destinatário do e-mail
  Set dictMails = CreateObject("scripting.dictionary")
  For Each cell In Sheets("publico").Range("H2:H2000").Cells
      destinatario = cell.value
      If Len(destinatario) = 0 Then destinatario = cell.Offset(1, 0).value
      If Len(destinatario) > 0 Then
          If Not dictMails.exists(destinatario) Then
              Set dictMails(destinatario) = New Collection 'to hold the linked rows
          End If
          dictMails(destinatario).Add cell.Row 'record this row
      End If
  Next cell

  'loop over the distinct recipients and their related rows
  For Each k In dictMails.keys

     Debug.Print "Recipient: " & k

  'build up the email body
  'corpodoemail = Sheets("CAPA").Range("F11").value & "<br><br>" & _
  Sheets("CAPA").Range("F13").value & "<br><br>"




'etc etc
'add the information from the linked rows

  For Each rw In dictMails(k)
      Debug.Print "    Row: " & rw
      With Sheets("publico").Rows(rw)
          corpodoemail = "<head><style>table, th, td {border: 1px solid black; border-collapse:" & _
          "collapse;}</style></head><body>" & _
          "<table style=""width:50%""><tr>" & _
          "<th bgcolor=""#D8D8D8"">MCI</th><th bgcolor=""#D8D8D8"">PRODUTO</th>" & _
          "<th bgcolor=""#D8D8D8"">DATA</th></tr><tr>" & _
          "<th>" & .Cells(1).value & "</th>" & "<th>" & .Cells(2).value & "</th>" & "<th>" & .Cells(4).value & "/" & .Cells(5).value & "</th>" & _
          "<th>" & .Cells(12).value & "</th>" & "<th>" & .Cells(12).value & "</th>" & "<th>" & .Cells(14).value & "/" & .Cells(55).value & "</th>"
      End With
  Next rw


  AssuntoEmail = Sheets("CAPA").Range("F8").value
  Set Email = OutlookApp.CreateItem(0)
      With Email
          .To = k
          .subject = AssuntoEmail
          .HTMLBody = corpodoemail
      End With

  Email.Send

  Next k 'próximo gerente

End Sub

Как я могу изменить этот код таким образом, чтобысценарий отправляет одно электронное письмо каждый раз, когда находит менеджера, и включает в него электронное письмо со списком клиентов?

Чтобы сделать его более понятным:

Клиент 1 и 2 изсписок, принадлежит ветви 1126, менеджеру 18, поэтому скрипт должен отправить и по электронной почте со строкой 2 и3 листа указанному менеджеру.

Возможно ли?

1 Ответ

0 голосов
/ 23 октября 2019

Вот как бы я это сделал. Некоторые части вашего кода удалены, поэтому общий подход более очевиден: должно быть понятно, что вам нужно добавить обратно. 

Private Sub CommandButton2_Click() 'envia o email com registro de log

    Dim dictMails As Object, k, rw
    Dim OutlookApp As Object
    Dim cell As Range
    Dim html As String

    Set OutlookApp = CreateObject("Outlook.Application")

    'start by grouping all rows related by the recipient...
    Set dictMails = CreateObject("scripting.dictionary")
    For Each cell In Sheets("publico").Range("H2:H2000").Cells
        'recipient, or default recipient?
        destinatario = cell.value
        If Len(destinatario) = 0 Then destinatario = cell.Offset(1, 0).value

        If Len(destinatario) > 0 Then
            If Not dictMails.exists(destinatario) Then
                Set dictMails(destinatario) = New Collection 'to hold the linked rows
            End If
            dictMails(destinatario).Add cell.Row 'record this row
        End If
    Next cell

    'loop over the distinct recipients and their related rows
    For Each k In dictMails.keys

        Debug.Print "Recipient: " & k 

        'build up the email body
        html = "<head><style>table, th, td " & _
              "{border: 1px solid black; border-collapse:" & _
              "collapse;}</style></head><body>"

        html = html & "Here is your information:<br><br>"

        'open the table
        html = html & "<table style=""width:50%""><tr>" & _
           "<th bgcolor=""#D8D8D8"">MCI</th><th bgcolor=""#D8D8D8"">" & _
           "PRODUTO</th><th bgcolor=""#D8D8D8"">DATA</th></tr>"


        'add one row for each linked row
        For Each rw In dictMails(k)
            Debug.Print "    Row: " & rw
            With Sheets("publico").Rows(rw)

               html = html & "<tr><td>" & .Cells(1).value & "</td>" & _
                 "<td>" & .Cells(2).value & "</td>" & _
                "<td>" & .Cells(4).value & "/" & .Cells(5).value & "</td>" & _
                "<td>" & .Cells(12).value & "</td>" & _
                "<td>" & .Cells(12).value & "</td>" & _
                "<td>" & .Cells(14).value & "/" & .Cells(55).value & "</td></tr>"

            End With
        Next rw

        html = html & "</table></body></html>"  '<< close the mail

        'send the mail for this recipient....

    Next k 'next recipient

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...