M
Marnie
I need to send an email to a group of people whose names are in several
fields in a spreadsheet. I look up the fields based on a value in a
different worksheet. It is building the list properly but the email is not
working. There is no error, but I do not receive the email. Here is my
code:
Sub CCLISTNew()
Dim OutApp As Object
Dim OutMail As Object
Dim CCList As Variant
Dim tmplist As Variant
Dim MailList As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
Set LkRange = Worksheets("Contact List").Range("A2:F25")
If Sheets("Hold Reasons").Range("C28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 2, False)
MailList = MailList + tmplist + ","
End If
If Sheets("Hold Reasons").Range("D28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 3, False)
MailList = MailList + tmplist + ","
End If
If Sheets("Hold Reasons").Range("E28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 4, False)
MailList = MailList + tmplist + ","
End If
If Sheets("Hold Reasons").Range("F28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 5, False)
MailList = MailList + tmplist + ","
End If
On Error Resume Next
CCList = Split(MailList, ",")
ActiveWorkbook.SendMail Recipients:=Array(CCList), Subject:="QC Hold
Notification"
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Erase CCList
End Sub
fields in a spreadsheet. I look up the fields based on a value in a
different worksheet. It is building the list properly but the email is not
working. There is no error, but I do not receive the email. Here is my
code:
Sub CCLISTNew()
Dim OutApp As Object
Dim OutMail As Object
Dim CCList As Variant
Dim tmplist As Variant
Dim MailList As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
Set LkRange = Worksheets("Contact List").Range("A2:F25")
If Sheets("Hold Reasons").Range("C28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 2, False)
MailList = MailList + tmplist + ","
End If
If Sheets("Hold Reasons").Range("D28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 3, False)
MailList = MailList + tmplist + ","
End If
If Sheets("Hold Reasons").Range("E28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 4, False)
MailList = MailList + tmplist + ","
End If
If Sheets("Hold Reasons").Range("F28") = "X" Then
tmplist = Application.WorksheetFunction.VLookup(Range("D6"),
LkRange, 5, False)
MailList = MailList + tmplist + ","
End If
On Error Resume Next
CCList = Split(MailList, ",")
ActiveWorkbook.SendMail Recipients:=Array(CCList), Subject:="QC Hold
Notification"
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Erase CCList
End Sub