Advertisement
Guest User

Untitled

a guest
Sep 5th, 2017
636
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.10 KB | None | 0 0
  1. Const cdoSendUsingPickup = 1
  2. Const cdoSendUsingPort = 2
  3. Const cdoAnonymous = 0
  4. ' Use basic (clear-text) authentication.
  5. Const cdoBasic = 1
  6. ' Use NTLM authentication
  7. Const cdoNTLM = 2 'NTLM
  8.  
  9. Public Sub SendEmail()
  10. Dim imsg As Object
  11. Dim iconf As Object
  12. Dim flds As Object
  13. Dim schema As String
  14.  
  15. Set imsg = CreateObject("CDO.Message")
  16. Set iconf = CreateObject("CDO.Configuration")
  17. Set flds = iconf.Fields
  18.  
  19. ' send one copy with SMTP server (with autentication)
  20. schema = "http://schemas.microsoft.com/cdo/configuration/"
  21. flds.Item(schema & "sendusing") = cdoSendUsingPort
  22. flds.Item(schema & "smtpserver") = "mail.myserver.com"
  23. flds.Item(schema & "smtpserverport") = 25
  24. flds.Item(schema & "smtpauthenticate") = cdoBasic
  25. flds.Item(schema & "sendusername") = "email@email.com"
  26. flds.Item(schema & "sendpassword") = "password"
  27. flds.Item(schema & "smtpusessl") = False
  28. flds.Update
  29.  
  30. With imsg
  31. .To = "email@email.com"
  32. .From = "email@email.com"
  33. .Subject = "Test Send"
  34. .HTMLBody = "Test"
  35. '.Sender = "Sender"
  36. '.Organization = "My Company"
  37. '.ReplyTo = "address@mycompany.com"
  38. Set .Configuration = iconf
  39. .Send
  40. End With
  41.  
  42. Set iconf = Nothing
  43. Set imsg = Nothing
  44. Set flds = Nothing
  45. End Sub
  46.  
  47. sMailServer = "myISPsmtp" 'Not just any old smtp
  48. sMailFromAddress = "me"
  49. sMailToAddress = "me"
  50.  
  51. Set ObjMessage = CreateObject("CDO.Message")
  52. sToAddress = sMailToAddress
  53. sSubject = "Subject"
  54. sBody = "MailBody"
  55.  
  56. ObjMessage.Subject = sSubject
  57. ObjMessage.From = sMailFromAddress
  58. ObjMessage.To = sToAddress
  59. 'ObjMessage.cc = sCCAddress
  60. ObjMessage.TextBody = sBody
  61. 'ObjMessage.AddAttachment sMailAttachment
  62. ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  63. ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = sMailServer
  64. ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  65. ObjMessage.Configuration.Fields.Update
  66. ObjMessage.send
  67.  
  68. Sub SMPTTest2()
  69. Set emailObj = CreateObject("CDO.Message")
  70.  
  71. emailObj.From = "name@myaddress.com"
  72. emailObj.To = "name@youraddress.com"
  73. emailObj.Subject = "Test CDO"
  74. emailObj.TextBody = "Test CDO"
  75. 'emailObj.AddAttachment "c:windowswin.ini"
  76.  
  77. Set emailConfig = emailObj.Configuration
  78.  
  79.  
  80. emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  81. emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
  82. emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
  83. 'Exclude the following line
  84. 'emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
  85. emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
  86. emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "name@myaddress.com"
  87. emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
  88. emailConfig.Fields.Update
  89.  
  90. emailObj.Send
  91.  
  92. If Err.Number = 0 Then MsgBox "Done"
  93. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement