Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Const cdoSendUsingPickup = 1
- Const cdoSendUsingPort = 2
- Const cdoAnonymous = 0
- ' Use basic (clear-text) authentication.
- Const cdoBasic = 1
- ' Use NTLM authentication
- Const cdoNTLM = 2 'NTLM
- Public Sub SendEmail()
- Dim imsg As Object
- Dim iconf As Object
- Dim flds As Object
- Dim schema As String
- Set imsg = CreateObject("CDO.Message")
- Set iconf = CreateObject("CDO.Configuration")
- Set flds = iconf.Fields
- ' send one copy with SMTP server (with autentication)
- schema = "http://schemas.microsoft.com/cdo/configuration/"
- flds.Item(schema & "sendusing") = cdoSendUsingPort
- flds.Item(schema & "smtpserver") = "mail.myserver.com"
- flds.Item(schema & "smtpserverport") = 25
- flds.Item(schema & "smtpauthenticate") = cdoBasic
- flds.Item(schema & "sendusername") = "email@email.com"
- flds.Item(schema & "sendpassword") = "password"
- flds.Item(schema & "smtpusessl") = False
- flds.Update
- With imsg
- .To = "email@email.com"
- .From = "email@email.com"
- .Subject = "Test Send"
- .HTMLBody = "Test"
- '.Sender = "Sender"
- '.Organization = "My Company"
- '.ReplyTo = "address@mycompany.com"
- Set .Configuration = iconf
- .Send
- End With
- Set iconf = Nothing
- Set imsg = Nothing
- Set flds = Nothing
- End Sub
- sMailServer = "myISPsmtp" 'Not just any old smtp
- sMailFromAddress = "me"
- sMailToAddress = "me"
- Set ObjMessage = CreateObject("CDO.Message")
- sToAddress = sMailToAddress
- sSubject = "Subject"
- sBody = "MailBody"
- ObjMessage.Subject = sSubject
- ObjMessage.From = sMailFromAddress
- ObjMessage.To = sToAddress
- 'ObjMessage.cc = sCCAddress
- ObjMessage.TextBody = sBody
- 'ObjMessage.AddAttachment sMailAttachment
- ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
- ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = sMailServer
- ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
- ObjMessage.Configuration.Fields.Update
- ObjMessage.send
- Sub SMPTTest2()
- Set emailObj = CreateObject("CDO.Message")
- emailObj.From = "name@myaddress.com"
- emailObj.To = "name@youraddress.com"
- emailObj.Subject = "Test CDO"
- emailObj.TextBody = "Test CDO"
- 'emailObj.AddAttachment "c:windowswin.ini"
- Set emailConfig = emailObj.Configuration
- emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
- emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
- emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
- 'Exclude the following line
- 'emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
- emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
- emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "name@myaddress.com"
- emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
- emailConfig.Fields.Update
- emailObj.Send
- If Err.Number = 0 Then MsgBox "Done"
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement