I have a code in excel to run through columns of names / emails / cc's / subjects / one body text and create an email in my drafts folder with the corresponding details.
This uses the .to = , .cc = , etc.
Our email server no longer recognizes the emails that get put into that field. Our IT guy suspects that it's because we need to use the .recipients.add code in the macro instead of .to = .
I'm not familiar with it and I was wondering if your team could come up with something along those lines.
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String
For Each cell In Range("G1:G37")
strbody = strbody & cell.Value & vbNewLine
Next
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.CC = (Cells(cell.Row, "D").Value)
.Subject = (Cells(cell.Row, "E").Value)
.HTMLBody = "" & Cells(cell.Row, "A").Value & " - " & strbody
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
This uses the .to = , .cc = , etc.
Our email server no longer recognizes the emails that get put into that field. Our IT guy suspects that it's because we need to use the .recipients.add code in the macro instead of .to = .
I'm not familiar with it and I was wondering if your team could come up with something along those lines.
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String
For Each cell In Range("G1:G37")
strbody = strbody & cell.Value & vbNewLine
Next
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.CC = (Cells(cell.Row, "D").Value)
.Subject = (Cells(cell.Row, "E").Value)
.HTMLBody = "" & Cells(cell.Row, "A").Value & " - " & strbody
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub