Thanks Ken,
My macro is not going into Outlook. It is activating the Excel file and
using the send To from the file menu to send the email through Outlook. Is
there a way I can change the default of the new mail in Outlook to always
enable voting button while sending. If not, can I add something in my macro.
I am writing my macro to help you help me. please advise where I can include
the voting button enabling option.
Sub SEND_MAILS_AUTOMATIC()
Dim MACRO_FILE_NAME, MACRO_SHEET, MACRO_SH1 As String
Dim FILE_DIR, MAIL_SUB, MAIL_BODY_1, BU_ID, YTD_ID, QTD_ID, PER_ID,
FIL_ID, FLS_ID, YTS_ID, QTS_ID, PRS_ID As String
Dim LINE_CNT, ST_CNT As Integer
MACRO_FILE_NAME = Worksheets("macro").Cells(4, 11)
MACRO_SHEET = Worksheets("macro").Cells(5, 11)
MACRO_SH1 = Worksheets("macro").Cells(6, 11)
LINE_CNT = Worksheets(MACRO_SHEET).Cells(15, 11)
ST_CNT = Worksheets(MACRO_SHEET).Cells(14, 11)
FILE_DIR = Worksheets(MACRO_SHEET).Cells(30, 11)
MAIL_SUB = Worksheets(MACRO_SHEET).Cells(32, 11)
MAIL_BODY_1 = Worksheets(MACRO_SHEET).Cells(34, 11)
Do ' Outer loop.
Do While ST_CNT < LINE_CNT ' Inner loop.
ST_CNT = ST_CNT + 1 ' Increment Counter.
'call MAIL MERGE
MAIL_SEND MACRO_FILE_NAME, MACRO_SHEET, MACRO_SH1, LINE_CNT, ST_CNT,
MAIL_SUB, MAIL_BODY_1, FILE_DIR
If ST_CNT >= LINE_CNT Then
Check = False ' Set value of flag to False.
Exit Do ' Exit inner loop.
End If
Loop
Loop Until Check = False ' Exit outer loop immediately.
End Sub
Sub MAIL_SEND(MACRO_FILE_NAME, MACRO_SHEET, MACRO_SH1, LINE_CNT, ST_CNT,
MAIL_SUB, MAIL_BODY_1, FILE_DIR)
Dim FILE_NAME, MAIL_BODY_2, DEPT_ID As String
Dim ADD_1, ADD_2, ADD_3, ADD_4, ADD_5, ADD_6, ADD_7 As String
BU_ID = Worksheets(MACRO_SH1).Cells(ST_CNT, 2)
FLS_ID = Worksheets(MACRO_SH1).Cells(ST_CNT, 13)
ADD_1 = Worksheets(MACRO_SH1).Cells(ST_CNT, 20)
ADD_2 = Worksheets(MACRO_SH1).Cells(ST_CNT, 21)
ADD_3 = Worksheets(MACRO_SH1).Cells(ST_CNT, 22)
ADD_4 = Worksheets(MACRO_SH1).Cells(ST_CNT, 23)
ADD_5 = Worksheets(MACRO_SH1).Cells(ST_CNT, 24)
ADD_6 = Worksheets(MACRO_SH1).Cells(ST_CNT, 25)
ADD_7 = Worksheets(MACRO_SH1).Cells(ST_CNT, 26)
Workbooks.Open Filename:=FILE_DIR & FLS_ID
Workbooks(FLS_ID).HasRoutingSlip = True
With Workbooks(FLS_ID).RoutingSlip
.Recipients = Array(ADD_1, ADD_2, ADD_3, ADD_4, ADD_5, ADD_6, ADD_7)
.Subject = "CC Owner - " & BU_ID & " - " & MAIL_SUB
.Message = MAIL_BODY_1
.ReturnWhenDone = False
.TrackStatus = False
.Delivery = xlAllAtOnce
End With
Workbooks(FLS_ID).Route
ActiveWorkbook.Close SaveChanges:=False
End Sub
Thanks again for your help!!