CDO.Message


Author: Dave
Date: 07.17.16 - 7:38am



' From http://www.vbknowledgebase.com/?Id=21&Desc=Send-Email(E-Mail)-from-VB6-using-CDO

'****************************************************************
'*  Purpose :   To Send eMail
'*
'*  Inputs  :   strRecipient(String)    Recipient comma seperated
'*              strSubject(String)      Subject
'*              strBody                  Body
'*              colAttachments          Collection of attachments
'*                                      file paths.
'*
'*  Returns :   Boolean about the sent status
'****************************************************************
Public Function SendEmail(ByVal strSender As String, _
                        ByVal strRecipient As String, _
                        ByVal strSubject As String, _
                        ByVal strBody As String, _
                        Optional ByVal strCc As String, _
                        Optional ByVal strBcc As String, _
                        Optional ByVal colAttachments As Collection _
                         ) As Boolean
    Dim cdoMsg As New CDO.Message
    Dim cdoConf As New CDO.Configuration
    Dim schema As String
    Dim Flds
    Dim attachment
    Dim strHTML
    
    On Error GoTo ErrTrap
    Const cdoSendUsingPort = 2
    
    'Set cdoMsg =  CreateObject("CDO.Message")
    'Set cdoConf = CreateObject("CDO.Configuration")
    
    Set Flds = cdoConf.Fields
        
    schema = "http://schemas.microsoft.com/cdo/configuration/"

    With Flds
        .Item(schema & "sendusing") = 2
        .Item(schema & "smtpserver") = "smtp.gmail.com"
        .Item(schema & "smtpserverport") = 465
        .Item(schema & "smtpauthenticate") = 1
        .Item(schema & "sendusername") = "youremail@gmail.com"
        .Item(schema & "sendpassword") = "yourpassword"
        .Item(schema & "smtpusessl") = 1
        .Update
    End With
    
    ' Apply the settings to the message.
    With cdoMsg
        Set .Configuration = cdoConf
        .To = strRecipient
        .From = strSender
        .Subject = strSubject
        .TextBody = strBody
        If Not colAttachments Is Nothing Then
            For Each attachment In colAttachments
                .AddAttachment attachment
            Next
        End If
        If strCc <> "" Then .CC = strCc
        If strBcc <> "" Then .BCC = strBcc
        .Send
    End With
    
    Set cdoMsg = Nothing
    Set cdoConf = Nothing
    Set Flds = Nothing
        
    SendEmail = True
    Exit Function
ErrTrap:
Err.Raise Err.Number, "", "Error from Functions.SendEmail" & Err.Description
    SendEmail = False
End Function





Comments: (0)

 
Leave Comment:
Name:
Email: (not shown)
Message: (Required)
Math Question: 38 + 83 = ? followed by the letter: H 



About Me
More Blogs
Main Site
Posts: (All)
2024 ( 1 )
2023 ( 9 )
2022 ( 4 )
2021 ( 2 )
2020 ( 4 )
2019 ( 5 )
2018 ( 6 )
2017 ( 6 )
2016 (22)
     VB6 CDECL
     UDT Tricks pt2
     Remote Data Extraction
     Collection Extender
     VB6 FindResource
     CDO.Message
     DirList Single Click
     Reset CheckPoint VPN Policy
     VB6 BSTR Oddities Explained
     SafeArrays in C
     BSTR and Variant in C++
     Property let optional args
     Misc Libs
     Enum Named Pipes
     Vb6 Collection in C++
     VB6 Overloaded Methods
     EXPORT FUNCDNAME Warning
     VB6 Syncronous Socket
     Simple IPC
     VB6 Auto Resize Form Elements
     Mach3 Automation
     Exit For in While
2015 ( 15 )
2014 ( 25 )
2013 ( 4 )
2012 ( 10 )
2011 ( 7 )
2010 ( 11 )
2009 ( 3 )