Warm tip: This article is reproduced from serverfault.com, please click

Fill email text with cell values from a list of variable length

发布于 2020-12-03 16:10:44

I have a list in column "A" with company names. Those company's employees are in column "B". In column "C" the date they started working.
enter image description here

Some have 10 employees some have 1 employee. I would like to send an e-mail with a standard text. In that text there should be the names of the employees and the start dates.

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

In column "O" are the e-mail addresses to send the e-mail to.

I need to fill the variable names with the names and the variable dates with the dates.

Questioner
Vincent Berg
Viewed
0
Evil Blue Monkey 2020-12-04 20:42:51

Try this code:

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

I though that putting employees' name and starting date together would make more sense. The code checks if the mail address has been already encountered and do not send more than a mail each. It creates a list of employees' names and starting date based upon the company name specified in the same row of the given address. This mean that if you have 2 (or more) different e-mails for the same company, 2 (or more) mails will be sent (1 for each e-mail) both with the full list of employees' name and starting date of the given company. The code should work independently from the sorting order of the list.

I've never sent an e-mail via code, so i assume that the part of your code that deal with such task and that i've integrated in my code is already working. The code can be improved by adding a mean to specify the message part now set as "Here some text that explains why we send this e-mail", another one to specify the subject of the e-mail and another one to specify a possible attachment to the e-mail.