极湖

Sub SendMailCDONTS(aTo, Subject, TextBody, aFrom)
  Const CdoBodyFormatText = 1
  Const CdoBodyFormatHTML = 0
  Const CdoMailFormatMime = 0
  Const CdoMailFormatText = 1
  Dim Message 'As New cdonts.NewMail
  
  'Create CDO message object
  Set Message = CreateObject("CDONTS.NewMail")
  With Message
    
    'Set email adress, subject And body
    .To = aTo
    .Subject = Subject
    .Body = TextBody
    
    'set mail And body format
    .MailFormat = CdoMailFormatText
    .BodyFormat = CdoBodyFormatText
    
    'Set sender address If specified.
    If Len(aFrom) > 0 Then .From = aFrom
    
    'Send the message
    .Send
  End With
End Sub

Sub SendMailCDO(aTo, Subject, TextBody, aFrom)
  Const cdoOutlookExvbsss = 2
  Const cdoIIS = 1
  
  Dim Message 'As New CDO.Message
  
  'Create CDO message object
  Set Message = CreateObject("CDO.Message")
  With Message
    'Load IIS configuration
    .Configuration.Load cdoIIS
    
    'Set email adress, subject And body
    .To = aTo
    .Subject = Subject
    .TextBody = TextBody
    
    'Set sender address If specified.
    If Len(aFrom) > 0 Then .From = aFrom
    
    'Send the message
    .Send
  End With
End Sub

Sub SendMailCDOCacheConf(aTo, Subject, TextBody, aFrom)
  'cached configuration  
  Dim Conf ' As New CDO.Configuration
  If IsEmpty(Conf) Then
    Const cdoOutlookExvbsss = 2
    Const cdoIIS = 1
    Set Conf = CreateObject("CDO.Configuration")
    Conf.Load cdoIIS
  End If
  
  Dim Message 'As New CDO.Message
  
  'Create CDO message object
  Set Message = CreateObject("CDO.Message")
  With Message
    'Set cached configuration
    Set .Configuration = Conf
    
    'Set email adress, subject And body
    .To = aTo
    .Subject = Subject
    .TextBody = TextBody
    
    'Set sender address If specified.
    If Len(aFrom) > 0 Then .From = aFrom
    
    'Send the message
    .Send
  End With
End Sub

Sub SendMailCDOCacheConf(aTo, Subject, TextBody, aFrom)
  'cached configuration  
  Dim Conf  'As New CDO.Configuration
  If IsEmpty(Conf) Then
    Const cdoSendUsingPort = 2
    
    Set Conf = CreateObject("CDO.Configuration")
    
    With Conf.Fields
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") =   cdoSendUsingPort
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "your.smtp.server"
      .Update
    End With
  End If
  
  Dim Message 'As New CDO.Message
  
  'Create CDO message object
  Set Message = CreateObject("CDO.Message")
  With Message
    'Set cached configuration
    Set .Configuration = Conf
    
    'Set email adress, subject And body
    .To = aTo
    .Subject = Subject
    .TextBody = TextBody
    
    'Set sender address If specified.
    If Len(aFrom) > 0 Then .From = aFrom
    
    'Send the message
    .Send
  End With
End Sub

Sub SendMailOutlook(aTo, Subject, TextBody, aFrom)
  
  'Create an Outlook object
  Dim Outlook 'As New Outlook.Application
  Set Outlook = CreateObject("Outlook.Application")
  
  'Create e new message
  Dim Message 'As Outlook.MailItem
  Set Message = Outlook.CreateItem(olMailItem)
  With Message
    'You can display the message To debug And see state
    '.Display
    
    .Subject = Subject
    .Body = TextBody
    
    'Set destination email address
    .Recipients.Add (aTo)
    
    'Set sender address If specified.
    Const olOriginator = 0
    If Len(aFrom) > 0 Then .Recipients.Add(aFrom).Type = olOriginator
    
    'Send the message
    .Send
  End With
End Sub