integrate a macro that sends email with the CDO system with the introduction of sendi

stefanoste78

New member
Joined
Jun 25, 2017
Messages
27
Reaction score
0
Points
1
Excel Version(s)
2010
Good evening.

I have a macro that sends email with the CDO system valid for sheet 1 of the attached file.

I would like it to apply to the code requirements, so you can enter sending options.

I have prepared the table of instructions for sending to sheet 3 (from column "M" to "R", for each email of column "I") which is the sheet that applies to the integrated code.

Thank you for your help.
 

Attachments

  • SendMail_Full official.xlsm
    23.1 KB · Views: 32
Avoid 'merged cells'.

I'd use:

Code:
Sub SendMail()
   sn = Foglio1.Cells(1).CurrentRegion
   
   For j = 2 To UBound(sn)
        sq = Array(True, 1, sn(j, 10), sn(j, 11), 60, sn(j, 12), 2, sn(j, 13))
   
        With CreateObject("CDO.Message")
            .Configuration(cdoSMTPUseSSL) = sq(0)
            .Configuration(cdoSendUserName) = sq(1)
            .Configuration(cdoSMTPAuthenticate) = sq(2)
            .Configuration(cdoSendPassword) = sq(3)
            .Configuration(cdoSMTPConnectionTimeout) = sq(4)
            .Configuration(cdoSMTPServer) = sq(5)
            .Configuration(cdoSendUsingMethod) = sq(6)
            .Configuration(cdoSMTPServerPort) = sq(7)
            .Configuration.Fields.Update
        
            .To = sn(j, 1)
            .CC = sn(j, 3)
            .BCC = sn(j, 4)
            .Subject = sn(j, 5)
            .TextBody = sn(j, 6)
            If sn(j, 7) <> "" Then .addattachment sn(j, 7)
            If sn(j, 8) <> "" Then .addattachment sn(j, 8)
            If sn(j, 9) <> "" Then .addattachment sn(j, 9)
            
            .Fields("urn:schemas:httpmail:importance") = 2
            .Fields("urn:schemas:mailheader:X-Priority") = 1
            .Fields("urn:schemas:mailheader:return-receipt-to") = .From
            .Fields("urn:schemas:mailheader:disposition-notification-to") = .From
            .Fields.Update
            .send
        End With
    Next
End Sub
 
Last edited:
hello snb.
Thank you for your intervention.
A question if you allow me. Does your macro replace my valid for sheet 1? if so, could you apply the sending options provided for in sheet 3?
Thank you
 
Amended code:

Code:
Sub SendMail()
   sn = Foglio1.Cells(1).CurrentRegion
   
   For j = 2 To UBound(sn)
        With CreateObject("CDO.Message")
            .Configuration(cdoSMTPUseSSL) = True
            .Configuration(cdoSendUserName) = 1
            .Configuration(cdoSMTPAuthenticate) = sn(j, 10)
            .Configuration(cdoSendPassword) = sn(j, 11)
            .Configuration(cdoSMTPConnectionTimeout) = 60
            .Configuration(cdoSMTPServer) = sn(j, 12)
            .Configuration(cdoSendUsingMethod) = 2
            .Configuration(cdoSMTPServerPort) = sn(j, 14)
            .Configuration.Fields.Update
        
            .To = sn(j, 1)
            .CC = sn(j, 3)
            .BCC = sn(j, 4)
            .From = sn(j, 2)
            .Subject = sn(j, 5)
            .TextBody = sn(j, 6)
            If sn(j, 7) <> "" Then .addattachment sn(j, 7)
            If sn(j, 8) <> "" Then .addattachment sn(j, 8)
            If sn(j, 9) <> "" Then .addattachment sn(j, 9)
            
            .Fields("urn:schemas:httpmail:importance") = 2
            .Fields("urn:schemas:mailheader:X-Priority") = 1
            .Fields("urn:schemas:mailheader:return-receipt-to") = sn(j, 2)
            .Fields("urn:schemas:mailheader:disposition-notification-to") = sn(j, 2)
            .Fields.Update
            .send
        End With
    Next
End Sub
 
Sorry if I intervene now in the forum. I have not had way before.


I tried my macro and I noticed that it is no longer good. This happened despite the fact that I unlocked third-party google access and connected to the email first from internet explorer. the same applies to the macros inserted by "snb". I would like to understand why ...


In the first message I noticed that I incorrectly indicated the wrong sheet and that in sheet 3 I omitted a column. For this I insert the new file with detailed instructions:


sheet 1:


The macro for sheet 1 is already inserted but it does not go any further. Give me this error:


system error & h80040213 (-2147220973)


Why do you do this?


Sheet 2:
I would need a macro that takes into account the sending options to be applied to all the emial indicated by cell "K10" down. Basically the options apply to all emails.


Sheet 3:


I would need a macro that takes into account the sending options to be applied to all the emial indicated by cell "K10" down for classes of email with the same "cod" code. Basically the options apply to all emails with the same "cod". While the macros of sheet 1 and 2 will use them to send emails in a single state the emails of sheet 3 will be used to send emails in different states (distinct from the code "cod").


I hope I was clear this time.


Thank you
 

Attachments

  • SendMail_Full official 1.xlsm
    25.3 KB · Views: 23
in the message in correspondence of sheet 3 the cell is not "k10" but "L3" in down.
 
Back
Top