WiserBit

 
Option Explicit
 
Private Sub cmdAddFile_Click()
 
'Add attachments:

On Error GoTo ErrcmdAddFile_Click
 
With CommonDialog1
 
    .ShowOpen
 
 
    If Err = 0 Then
 
        If Trim(.FileName) <> "" Then
 
            lstAttachments.AddItem .FileName
          Else
 
            Exit Sub
 
        End If
    End If
 
End With
 
Exit Sub
 
ErrcmdAddFile_Click:
 
End Sub
 
Private Sub cmdRemove_Click()
 
'Remove an attachment:

On Error Resume Next
 
lstAttachments.RemoveItem lstAttachments.ListIndex
 
End Sub
 
Public Sub SendEMail()
 
'Set the properties and send the email:

Dim i As Integer
Dim ulimit As Integer
Dim m_strAttachedFiles As String
Dim strTemp As String
Dim c As Control
 
On Error GoTo ErrSendEMail
 
'Error handler
If Me.txtTo = "" Then
  MsgBox "Please enter an E-Mail Address!"
  Exit Sub
End If
 
'Get all the attachments
ulimit = lstAttachments.ListCount
 
Select Case ulimit
 
Case Is > 1
  For i = 0 To ulimit - 1
      m_strAttachedFiles = lstAttachments.List(i) + ";" + m_strAttachedFiles
  Next i
      'Cut the ; from the rest
      If Right$(m_strAttachedFiles, 1) = ";" Then
          m_strAttachedFiles = Left$(m_strAttachedFiles, Len(m_strAttachedFiles) - 1)
      End If
Case 1
      i = 0
      m_strAttachedFiles = lstAttachments.List(i)
 
End Select
 
' These are optioanl properties.
' You must set them first if you decide to use them:
cEmail1.SMTPPort = Val(txtPort.Text)
cEmail1.SMTPHostValidation = validate_none
cEmail1.EmailAddressValidation = VALIDATE_SYNTAX
cEmail1.Delimiter = ";"
 
' The email properties:
cEmail1.SMTPHost = txtHost.Text
cEmail1.From = txtFromEMail.Text
cEmail1.FromDisplayName = txtFromEMail.Text
cEmail1.Recipient = txtTo.Text
cEmail1.Subject = Me.txtSubject
 
 'Don't forget to add the new line to the
 'end of the message.
cEmail1.Message = rtfMail.Text & vbCrLf
cEmail1.Attachment = Trim(m_strAttachedFiles)
 
' More properties:
cEmail1.AsHTML = False
cEmail1.UseAuthentication = False
cEmail1.UsePopAuthentication = True
cEmail1.Username = txtUserName.Text
cEmail1.Password = txtPassword.Text
cEmail1.POP3Host = txtHost.Text
 
'Send the email:
cEmail1.send
 
Exit Sub
 
ErrSendEMail:
    MsgBox "Error SendEMail" & Err.Description & "(" & Err.Number & ")", vbInformation
 
End Sub
Private Sub cmdSendMail_Click()
SendEMail
End Sub
 
Private Sub Form_Load()
 
'Init the control:
'Must be call before using any
'functionality of the control.
'sKey = Your registration key.
'On trial mode use the "Trial Mode."
cEmail1.Init "Trial Mode."
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
'Release the control
'from the memory:
cEmail1.DeInit
 
End Sub
 
 
' *****************************************************************************
' Events
' *****************************************************************************

Private Sub cEmail1_Progress(lPercentCompete As Long)
 
Status.Caption = lPercentCompete
 
End Sub
 
Private Sub cEmail1_SendFailed(Explanation As String)
 
'SendFailed Event

MsgBox ("Your attempt to send mail failed for the following reason(s): " & vbCrLf & Explanation)
 
Debug.Print "Your attempt to send mail failed for the following reason(s): " & vbCrLf & Explanation
 
End Sub
 
Private Sub cEmail1_SendSuccesful()
 
'SendSuccesful Event'

MsgBox "SendSuccesful"
 
End Sub
 
Private Sub cEmail1_Status(Status As String)
 
'Status Event

txtStatus.Text = txtStatus.Text & Time & ":" & Status & vbCrLf
 
End Sub