Sunday, August 2, 2009

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
Exit Sub
Set Flds = Nothing
Set imsg = Nothing
End Sub


Looking for local information? Find it on Yahoo! Local

No comments:

Post a Comment