Error - auto mail extracting mail address from cells

[Mahesh Rana]

Need your support
Thus code send mail to all the addresses in Column A as .TO, B as .CC & C as .BCC BUT
for each no. of mail-ids, I had to click [allow] as many times in outlook to send mail.
Would it be possible to click [allow] only once to send mail.

Option Explicit


Private Sub CommandButton1_Click()
On Error GoTo ErrHandler
Dim lrow As Long 'last row


With ActiveSheet
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With


' SET Outlook APPLICATION OBJECT.
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")


' CREATE EMAIL OBJECT.
Dim objEmail As Object
Dim I As Integer


For I = 2 To lrow


    Set objEmail = objOutlook.CreateItem(0)
    
    On Error Resume Next
    With objEmail
        .To = Range("A" & I)
        .CC = Range("B" & I)
        .BCC = Range("C" & I)
        .Subject = "COLD CHAIN DISPATCHES DATED " & Date
        .Body = "Pls. have the details in attachment."
        .Attachments.Add ("C:\Users\NARESH\Desktop\COLD CHAIN RECIPT.xlsx")
        .Send
    End With


Next I


' CLEAR.
Set objEmail = Nothing: Set objOutlook = Nothing


ErrHandler:
'
End Sub

 

[Mahesh Rana]

Need a helping hand for trailing VBA.

 

[Mahesh Rana]

need support