Quantcast
Channel: VBForums - ASP, VB Script
Viewing all articles
Browse latest Browse all 699
↧

[RESOLVED] Custom Action in Mail : Need to make it working like "reply to all"

$
0
0
i created Tapping emails from excel template which call outlook function to send email. once resource recieve the email. Resource will see selection which is similar to voting buttons ex. Acknowledge/Completed/Issue. once resource responded to the email only the sender will recieve the response. what i need is all in CC: will also recieve the response of the resource:confused: please help. .

---------------------------------------------------------------------------------------

Sub R4Send_Tapping()
ActiveSheet.Buttons.Visible = False
Dim sendRng As Range
Dim Subject, ToList, CcList As String
Dim OutApp As Outlook.Application
Dim myAction1 As Outlook.Action
Dim myAction2 As Outlook.Action
Dim myAction3 As Outlook.Action


Set OutApp = CreateObject("Outlook.Application")

On Error GoTo StopMacro

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

If ActiveWorkbook.Sheets("Values").Range("B3") <> "" Then
Subject = "DSI TAPPING EMAIL: Please begin execution of " & ActiveWorkbook.Sheets("values").Range("B3")
Else
Subject = "DSI TAPPING EMAIL: Please begin execution of tasks below"
End If

Call getLeads
ToList = removeRepeatEmails(Sheets("Values").Range("B1"))
CcList = removeRepeatEmails(Sheets("Values").Range("B2"))
ActiveSheet.Range("A1").Select
'If the selection is one cell it will send the whole worksheet
Set sendRng = Selection

'Create the mail and review it
With sendRng
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
With .Item
.To = ToList
.CC = CcList
.Subject = Subject
.Importance = 2
.FlagStatus = olFlagMarked
.FlagRequest = "[TASK EXECUTORS]: PLEASE ACKNOWLEDGE RECEIPT WITHIN 5 MINS BY REPLYING TO THIS EMAIL"
.ReminderSet = True
.FlagDueBy = DateAdd("n", 11, Now())
.ReminderTime = DateAdd("n", 11, Now())


Set myAction1 = .Actions.Add
myAction1.Name = "ACKNOWLEDGE"
myAction1.ReplyStyle = olIncludeOriginalText


Set myAction2 = .Actions.Add
myAction2.Name = "COMPLETE"
myAction2.ReplyStyle = olIncludeOriginalText


Set myAction3 = .Actions.Add
myAction3.Name = "ISSUE"
myAction3.ReplyStyle = olIncludeOriginalText



'Set .SentOnBehalfOfName = """DSI Cutover"" <ra-ncssg-aspac_dsi_c@its.jnj.com>"
Set .SendUsingAccount = OutApp.Session.Accounts.Item(4)

End With
End With
End With

StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
↧

Viewing all articles
Browse latest Browse all 699


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>