N
Need lots of help!
I have an excel macro setup to send email automatically from a list that
does not activate the Outlook Warning (Send_Msg). However, I tried to add a
reply recipient (AddReplyRecip)to the email, and now the outlook warning pops
up asking if I want to allow another program to access my outlook
AddReplyRecip.
Is there a way to program around this?
Sub Send_Msg()
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Dim strRecipName As String
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
strRecipName = "ALLTEL CALL CENTER BUSINESS IMPROVEMENT"
myBody = Range("C20")
For Each cell In Sheets("Email
List").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) =
"yes" Then
With objMail
.To = cell.Value
.Subject = "OPT OUT " & myBody
.Body = "This is a request to OPT OUT " & _
"all subscriptions to MDN: " & myBody & Chr(13) &
Chr(13) & "ALLTEL"
.Display
End With
If objMail.Class = olMail And _
objMail.Sent = False Then
Call AddReplyRecip(objMail, strRecipName)
End If
Set OutMail = Nothing
End If
Next cell
Set objOL = Nothing
End Sub
Private Sub AddReplyRecip(objMsg As MailItem, strName As String)
Dim colReplyRecips As Recipients
Dim objReplyRecip As Recipient
Dim strPrompt As String
Dim intRes As Integer
On Error Resume Next
objMsg.ReplyRecipients.Add (strName)
If Err = 287 Then
strMsg = "This message was sent from your profile." & _
" You must select Yes to ensure return mail" & _
" goes to the Short Code Support Team."
res = MsgBox(strMsg, vOk + vbDefaultButton1, _
"Security Prompt Cancelled")
If res = vbOK Then
Cancel = False
Else
objReplyRecip.Delete
End If
Err.Clear
End If
Set colReplyRecips = Nothing
Set objReplyRecip = Nothing
End Sub
does not activate the Outlook Warning (Send_Msg). However, I tried to add a
reply recipient (AddReplyRecip)to the email, and now the outlook warning pops
up asking if I want to allow another program to access my outlook
AddReplyRecip.
Is there a way to program around this?
Sub Send_Msg()
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Dim strRecipName As String
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
strRecipName = "ALLTEL CALL CENTER BUSINESS IMPROVEMENT"
myBody = Range("C20")
For Each cell In Sheets("Email
List").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) =
"yes" Then
With objMail
.To = cell.Value
.Subject = "OPT OUT " & myBody
.Body = "This is a request to OPT OUT " & _
"all subscriptions to MDN: " & myBody & Chr(13) &
Chr(13) & "ALLTEL"
.Display
End With
If objMail.Class = olMail And _
objMail.Sent = False Then
Call AddReplyRecip(objMail, strRecipName)
End If
Set OutMail = Nothing
End If
Next cell
Set objOL = Nothing
End Sub
Private Sub AddReplyRecip(objMsg As MailItem, strName As String)
Dim colReplyRecips As Recipients
Dim objReplyRecip As Recipient
Dim strPrompt As String
Dim intRes As Integer
On Error Resume Next
objMsg.ReplyRecipients.Add (strName)
If Err = 287 Then
strMsg = "This message was sent from your profile." & _
" You must select Yes to ensure return mail" & _
" goes to the Short Code Support Team."
res = MsgBox(strMsg, vOk + vbDefaultButton1, _
"Security Prompt Cancelled")
If res = vbOK Then
Cancel = False
Else
objReplyRecip.Delete
End If
Err.Clear
End If
Set colReplyRecips = Nothing
Set objReplyRecip = Nothing
End Sub