Reputation: 11
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
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