Send mail without using mail clients (Outlook) through VBA
Sub Sendmail()
Set imsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.Microsoft.Com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Range("B4").Value
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailid
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = pswd
.Update
End With
strBody = " Attached you will find your MMO notifications from <our company name here> on ship date: " & Format(Date, "mm/dd/yyyy")
With imsg
Set .Configuration = iConf
.To = mailid
.CC = ""
.BCC = ""
.From = mailid
.Subject = "Manual Markout Notification - " & Format(Date, "mm/dd/yyyy")
.TextBody = strBody
.AddAttachment (ThisWorkbook.Path & "/" & Replace(Replace(shtData.Range("AC2").Value, ".", ""), "/", "") & " " & Format(Date, "mm-dd-yyyy") & ".mhtml")
.Send
End With
Set Flds = Nothing
Set imsg = Nothing
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.Microsoft.Com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Range("B4").Value
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailid
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = pswd
.Update
End With
strBody = " Attached you will find your MMO notifications from <our company name here> on ship date: " & Format(Date, "mm/dd/yyyy")
With imsg
Set .Configuration = iConf
.To = mailid
.CC = ""
.BCC = ""
.From = mailid
.Subject = "Manual Markout Notification - " & Format(Date, "mm/dd/yyyy")
.TextBody = strBody
.AddAttachment (ThisWorkbook.Path & "/" & Replace(Replace(shtData.Range("AC2").Value, ".", ""), "/", "") & " " & Format(Date, "mm-dd-yyyy") & ".mhtml")
.Send
End With
Set Flds = Nothing
Set imsg = Nothing
Exit Sub
Set Flds = Nothing
Set imsg = Nothing
Set imsg = Nothing
End Sub
Comments
Post a Comment