У меня есть список в столбце «А» с названиями компаний. Эти сотрудники компании указаны в столбце «Б». В столбце «C» дата начала работы.
введите описание изображения здесь

В некоторых есть 10 сотрудников, в других - 1 сотрудник. Я хочу отправить электронное письмо со стандартным текстом. В этом тексте должны быть имена сотрудников и даты начала занятий.

Sub mailen()

Dim namen As String
Dim r As Range
Dim inhoud As String
Dim names As string
Dim dates As string

inhoud = "Hello client," & "<br>" & _
"Here some text that explains why we send this e-mail." & "<br>" & _
"It is about your employee(s): " & names & " " & "<br>" & _
"These employee(s) are working for you from the dates: " & dates & "." & "<br>"


For Each r In Range("O2", Range("O2").End(xlDown))
    If r.Value = r.Offset(-1, 0).Value Then
        r.Value = r.Value
    Else: namen = r.Value
    
        With CreateObject("Outlook.Application").createitem(0)
        .To = namen
        .Subject = "Test"
        .HTMLbody = inhoud
        .attachments.Add ("C:\.pdf")
        .send
        End With
    End If
Next r
End Sub

В столбце «О» указаны адреса электронной почты, на которые нужно отправить электронное письмо.

Мне нужно заполнить переменную names именами, а переменную dates датами.

0
Vincent Berg 3 Дек 2020 в 19:10

1 ответ

Лучший ответ

Попробуйте этот код:

Sub SubMailen()
    
    'Declarations.
    Dim RngMailingAddressList As Range
    Dim RngCompanyNameList As Range
    Dim RngEmployeeNameList As Range
    Dim RngStartingDateList As Range
    Dim RngTarget01 As Range
    Dim RngTarget02 As Range
    Dim StrMailingAddress As String
    Dim StrMessage As String
    
    'Setting ranges as the first cell of their column.
    Set RngMailingAddressList = Range("O2")
    Set RngCompanyNameList = Range("A2")
    Set RngEmployeeNameList = Range("B2")
    Set RngStartingDateList = Range("C2")
    
    'Resetting ranges to cover the whole list (based upon RngMailingAddressList).
    Set RngMailingAddressList = Range(RngMailingAddressList, RngMailingAddressList.End(xlDown))
    Set RngCompanyNameList = Range(RngCompanyNameList, RngCompanyNameList.Offset(RngMailingAddressList.Rows.Count - 1))
    Set RngEmployeeNameList = Range(RngEmployeeNameList, RngEmployeeNameList.Offset(RngMailingAddressList.Rows.Count - 1))
    Set RngStartingDateList = Range(RngStartingDateList, RngStartingDateList.Offset(RngMailingAddressList.Rows.Count - 1))
    
    'Covering each cell in RngMailingAddressList.
    For Each RngTarget01 In RngMailingAddressList
        
        'Checking if the address has not been encountered before.
        If Excel.WorksheetFunction.CountIf(Range(RngMailingAddressList.Cells(1, 1), RngTarget01), RngTarget01.Value) = 1 Then
            
            'Setting StrMailingAddress.
            StrMailingAddress = RngTarget01.Value
            
            'Setting first part of StrMessage.
            StrMessage = "Hello client," & "<br>" & _
            "Here some text that explains why we send this e-mail." & "<br>" & _
            "It is about your employee(s):" & "<br>"
            
            'Covering all the cells in RngCompanyNameList.
            For Each RngTarget02 In RngCompanyNameList
                'Checking if RngTarget02 has the same company name as the row of the address the mail is about to be sent.
                If RngTarget02.Value = Cells(RngTarget01.Row, RngCompanyNameList.Column).Value Then
                    'Adding name and starting date of the employee to StrMessage.
                    StrMessage = StrMessage & Cells(RngTarget02.Row, RngEmployeeNameList.Column).Value & " (working for you from " & Cells(RngTarget02.Row, RngStartingDateList.Column).Value & ")" & "<br>"
                End If
            Next
            
            'Setting and sending the mail.
            With CreateObject("Outlook.Application").createitem(0)
                .To = StrMailingAddress
                .Subject = "Test"
                .HTMLbody = StrMessage
                .attachments.Add ("C:\.pdf")
                .send
            End With
            
        End If
    Next
End Sub

Я подумал, что объединение имени сотрудников и даты начала работы имело бы больший смысл. Код проверяет, был ли уже встречен почтовый адрес, и не отправляет более одного письма каждый. Он создает список имен сотрудников и даты начала на основе названия компании, указанного в той же строке данного адреса. Это означает, что если у вас есть 2 (или более) разных электронных письма для одной и той же компании, будет отправлено 2 (или более) писем (по 1 на каждое электронное письмо) с полным списком имен сотрудников и датой начала данной компании. Код должен работать независимо от порядка сортировки списка.

Я никогда не отправлял электронное письмо с кодом, поэтому я предполагаю, что часть вашего кода, которая имеет дело с такой задачей и которую я интегрировал в свой код, уже работает. Код можно улучшить, добавив средство для указания части сообщения, которая теперь установлена ​​как «Здесь какой-то текст, объясняющий, почему мы отправляем это электронное письмо», еще один для указания темы электронного письма и еще один для указания возможного вложение к электронному письму.

0
Evil Blue Monkey 4 Дек 2020 в 12:42