Option Compare Database

Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
 
Function SendCDOMail(sTo As String, txtMailSubject As String, txtMsg As String, _
                     Optional sBCC As Variant, Optional AttachmentPath As Variant)
                   
    On Error GoTo Error_Handler
    Dim objCDOMsg       As Object
 
    Set objCDOMsg = CreateObject("CDO.Message")
 
    'CDO Configuration
    With objCDOMsg.Configuration.Fields
        '
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Server port (typically 25, 587)
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        'SMTP server IP or Name
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "webhosting2037.is.cc"
        'Type of authentication, NONE, Basic (Base64 encoded), NTLM
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'SMTP Account User ID
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "info@talisman.co.th"
        'SMTP Account Password
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*******"
        'Use SSL for the connection (False or True)
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Update
    End With
 
    'CDO Message
    objCDOMsg.Subject = txtMailSubject
    objCDOMsg.From = "info@talisman.co.th"
    objCDOMsg.To = "talisman.travel@gmail.com"
    objCDOMsg.TextBody = txtMsg
    ' Add attachments to the message.
   If Not IsMissing(AttachmentPath) Then
        If IsArray(AttachmentPath) Then
            For i = LBound(AttachmentPath) To UBound(AttachmentPath)
                If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
                    objCDOMsg.AddAttachment AttachmentPath(i)
                End If
            Next i
        Else
            If AttachmentPath <> "" And AttachmentPath(i) <> "False" Then
                objCDOMsg.AddAttachmentAttachmentPath
            End If
        End If
    End If
    objCDOMsg.Send

Error_Handler_Exit:
    On Error Resume Next
    Set objCDOMsg = Nothing
    Exit Function
 
Error_Handler:
   MsgBox "The following error has occured." & vbCrLf & vbCrLf & amp & "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: SendCDOMail" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

Private Sub SendEmail_Click()
    Dim strSMTPServer As String, intSMTPServerPort As Integer
    Dim strFrom As String, strFromDisplayName As String
    Dim strTo As String, strToDisplayName As String
    Dim strCC As String, strCCDisplayName As String
    Dim strReplyTo As String
    Dim strUsername As String, strPassword As String, bolAuthenticate As Boolean
    Dim strSubject As String
    Dim strMsg As String
    Dim strAttachment As String
    
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String

    'SMTP server settings
    strSMTPServer = "webhosting2037.is.cc"
    intSMTPServerPort = 465
    
    'From
    strFrom = "info@talisman.co.th"
    strFromDisplayName = "Talisman Travel Co. Ltd."

    'CC
    strCC = "office@tour2thailand.com"
    strCCDisplayName = "HotelContract"
    
    'ReplyTo (i.e. return address)
    strReplyTo = "info@talisman.co.th"

    'Authentication
    bolAuthenticate = False
    strUsername = "info@talisman.co.th"
    strPassword = "*******"
     
    'To
    Set dbs = CurrentDb()
    strSQL = "SELECT GenMail FROM Hotels WHERE Hotel=""" & Me![Hotel] & """"
    Set rst = dbs.OpenRecordset(strSQL)
    strTo = rst.Fields("GenMail") & vbNullString
    rst.Close
    Set rst = Nothing
    strToDisplayName = ""

    'Subject
    strSubject = "Attn.: " & Me![Manager] & ", " & Me![First]
    'strSubject = "Talisman Travel - Inquiry"
    
    If Len(Trim(strTo)) = 0 Then
        strTo = InputBox("THIS HOTEL HAS NO EMAIL ADDRESS. PLEASE, SPECIFY YOUR OWN", "EMAIL ADDRESS", "")
                         
        If Len(Trim(strTo)) = 0 Then
            MsgBox "THIS HOTEL HAS NO EMAIL ADDRESS. PLEASE, SPECIFY HOTEL'S EMAIL ADDRESS FIRST AND TRY AGAIN LATER", _
                    vbQuestion + vbOKOnly, "EMAIL"
                    
            Exit Sub
        End If
    End If
    
    strMsg = CreateHTMLReport
    strAttachment = modVBSendMail.VBSMCreateAttachmentFile(strMsg, "attachment.html")

    Set objSendMail = New vbSendMail.clsSendMail
    
    Call modVBSendMail.VBSMCreateEmail(objSendMail, strSMTPServer, intSMTPServerPort, _
                                        strFrom, strFromDisplayName, _
                                        strTo, strToDisplayName, strCC, strCCDisplayName, strReplyTo, _
                                        strSubject, strMsg, True, strAttachment, bolAuthenticate, _
                                        strUsername, strPassword)

    
    objSendMail.Send
    
    Set objSendMail = Nothing
End Sub

    Private Sub SendEmail_Click()
    Dim strSMTPServer As String, intSMTPServerPort As Integer
    Dim strFrom As String, strFromDisplayName As String
    Dim strTo As String, strToDisplayName As String
    Dim strCC As String, strCCDisplayName As String
    Dim strReplyTo As String
    Dim strUsername As String, strPassword As String, bolAuthenticate As Boolean
    Dim strSubject As String
    Dim strMsg As String
    Dim strAttachment As String
    
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String