5_Stripes_Fan86
5_Stripes_Fan86

Reputation: 11

Determine Outlook recipient based on Excel cell value for each email

Having trouble getting the .To = to fill in the information in column. I am trying set up where when "Resolved" is in column E then to .To = will fill in the adjacent employee id in column F when the macro is run. Below is what I have been able to research and make work but not having any luck with getting the To field to fill based on cell values. Thanks in advance for any assistance. Couldn't find anything on this exact scenario while researching.

Sub Send_Email()
    Dim rng As Range
    For Each rng In Range("E2:E22")
       If (rng.Value = "Resolved") Then
           Call mymacro(rng.Address)
       End If
    Next rng
End Sub

Private Sub mymacro(theValue As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi, your issue has been resolved should issues persist please contact 611 for additional assistance."
    On Error Resume Next
    With xOutMail
        .To = Cells().Value
        .CC = ""
        .BCC = ""
        .Subject = "Your issue has been resolved."
        .Body = xMailBody
        .Display   ' using .Send for final version
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Upvotes: 1

Views: 409

Answers (1)

Evanzheng
Evanzheng

Reputation: 211

You want to use Excel VBA to achieve Outlook mail delivery?

if so, You can use the following method to get the email address in range.

You can use Sheet1.Cells to get the email address in range. The email address is in the same row of the RNG object, the first column. Sheet1.Cells(rng.Row, 1).Value

When calling the mymacro(theValue As String) method, pass the email address to theValue parameter.

Therefore, in the mymacro(theValue As String) method, .To should use theValue parameter.

Sub Send_Email()
    Dim rng As Range
    For Each rng In Range("C1:C4")
          If (rng.Value = "2") Then
          Call mymacro(Sheet1.Cells(rng.Row, 1).Value)
       End If
    Next rng
End Sub

Private Sub mymacro(theValue As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi, your issue has been resolved should issues persist please contact 611 for additional assistance."
    On Error Resume Next
    With xOutMail
        .To = theValue
        .CC = ""
        .BCC = ""
        .Subject = "Your issue has been resolved."
        .Body = xMailBody
        .Display   ' using .Send for final version
        '.Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Upvotes: 1

Related Questions