How to develop a commercial e-Statement solution in vb6 step by step – Part 9 – Configure SMTP & Ping Using VB6

Configure e-Statement SMTP Server & Ping Using VB6

For our e-Statement application to be able to send out emails to our clients, we need to configure our SMTP Server. In this article we are going to create a form to allow as to configure our SMTP Server settings and also to be able to ping the server using VB6.

We have seen in a previous post on how to send mail using Gmail SMTP server. For this e-statement application , we are going to use GMail SMTP server to enable us send emails.

ATTENTION: This post is a continuation of previous posts. You will need to start from the start to be able to follow this post.

In Summary, we are going to do the following in this article

1. Create  SMTP Configuration Form
2. Send Test Mail Button
3. Ping Server Using Vb6

Lets open our SmartMail application and add a new Form. Name the Form as “frmPingServer” and give it a Caption of “SMTP Server Configuration”.

Ping Using VB6

On the right side of the form we  have the ping using vb6 the copyright owner does not allow me to publish the code on this website and I will exclude this part of the code. But don’t worry here is a link to the resource ping using vb 6

Configure SMTP Server

On the left side is where we are going to configure our SMTP Sever.

Add the following Controls on the Form.

SOURCE CODE

Copy and paste the code below, and if you have followed all the instruction it should work perfectly

'eStatement Application Development
'SMTP Server Configuration Module
'ping using vb6
'Send Mail in VB6 Using Gmail SMTP  & Ping Using VB6
'How to develop a commercial e-Statement solution in vb6  - Configure SMTP & Ping Using VB6
'www.smarttechdiary.com


Private Sub cmdSendTest_Click()
'Send Mail Using Gmail SMTP Server in VB6
Dim imsg As Object
Dim iConf As Object
Dim Flds As Variant


Set imsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = cboSSL.Text 'False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cboAuthenticate.Text '1 '0
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = textUser.Text 'example@domain.com
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = textPassword.Text 'Your Password
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = textServer.Text    'smtp.gmail.com
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cboSendUsing.Text   '2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = textPort        '25
.Update
End With





With imsg
Set .Configuration = iConf
.To = textUser
.cc = ""
.BCC = ""
' Note: The reply address
' you can add this line
' to change the reply address .ReplyTo = "Reply@something.com"
.From = "abdallanizar@smarttechdiary.com"
.Subject = "Your Smart Tech Diary Statement"
.HTMLBody = "

Test Message

"
On Error GoTo ErrHandler

.Send
Me.Caption = "Correct Server Configuration"
MsgBox "Test message successfull sent!", vbInformation, "SMTP Server Configuration"
Exit Sub
ErrHandler:
   MsgBox "Sorry user settings do not seem to work properly", vbExclamation
  'Call LogError("MySub", Err, Error$) ' passes name of current routine '
  Select Case err.Number
    Case "-2147220977"
        
    Open App.path & "/InvalidEmaillog.txt" For Append As #100
       Print #100, "Error Description:" & err.Description
    Close #100
    
    Case Else
       
   Open App.path & "/OtherErrorlog.txt" For Append As #101
       Print #101, "Error Description:" & err.Description & " " & err.Number
    Close #101
  End Select
End With
End Sub


Private Sub Form_Load()
'Load SMTP Server Configurations

cboSSL.Text = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=1", "SettingValue")
cboAuthenticate.Text = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=2", "SettingValue")
textUser.Text = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=3", "SettingValue")
textPassword.Text = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=4", "SettingValue")
textServer.Text = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=5", "SettingValue")
cboSendUsing.Text = getValueAt("SELECT SettingValue FROM AppSettings where  SettingID=6", "SettingValue")
textPort.Text = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=7", "SettingValue")

   Text1.Text = textServer.Text
   Text2.Text = ""
   Text3.Text = "Echo this"
   
   
'    SMTPUseSSL

cboAuthenticate.AddItem "0"
cboAuthenticate.AddItem "1"

cboSSL.AddItem "False"
cboSSL.AddItem "True"

cboSendUsing.AddItem "1"
cboSendUsing.AddItem "2"
End Sub

Private Sub cmdSave_Click()
'Save SMTP Server Configurations
On Error GoTo Error

Dim rsServer As New ADODB.Recordset
With rsServer

'    SMTPUseSSL
'-----------------------------------------------------------------------------------------------
.Open "SELECT * FROM AppSettings WHERE SettingID=1  ", CN, adOpenDynamic, adLockOptimistic
If Not rsServer.EOF Then
rsServer("SettingValue") = cboSSL.Text
.Update
End If
.Close

'    SMTPAuthenticate
'-----------------------------------------------------------------------------------------------
.Open "SELECT * FROM AppSettings WHERE SettingID=2  ", CN, adOpenDynamic, adLockOptimistic
If Not rsServer.EOF Then
rsServer("SettingValue") = cboAuthenticate.Text
.Update
End If
.Close
'    SendUsername
'-----------------------------------------------------------------------------------------------
.Open "SELECT * FROM AppSettings WHERE SettingID=3  ", CN, adOpenDynamic, adLockOptimistic
If Not rsServer.EOF Then
rsServer("SettingValue") = textUser.Text
.Update
End If
.Close
'    SendPassword
'-----------------------------------------------------------------------------------------------
.Open "SELECT * FROM AppSettings WHERE SettingID=4  ", CN, adOpenDynamic, adLockOptimistic
If Not rsServer.EOF Then
rsServer("SettingValue") = textPassword.Text
.Update
End If
.Close
'    SMTPServer
'-----------------------------------------------------------------------------------------------
.Open "SELECT * FROM AppSettings WHERE SettingID=5  ", CN, adOpenDynamic, adLockOptimistic
If Not rsServer.EOF Then
rsServer("SettingValue") = textServer.Text
.Update
End If
.Close
'    SendUsing
'-----------------------------------------------------------------------------------------------
.Open "SELECT * FROM AppSettings WHERE SettingID=6  ", CN, adOpenDynamic, adLockOptimistic
If Not rsServer.EOF Then
rsServer("SettingValue") = cboSendUsing.Text
.Update
End If
.Close
'    SMTPServerPort
'-----------------------------------------------------------------------------------------------
.Open "SELECT * FROM AppSettings WHERE SettingID=7  ", CN, adOpenDynamic, adLockOptimistic
If Not rsServer.EOF Then
rsServer("SettingValue") = textPort.Text
.Update
End If
.Close
End With
MsgBox "Updated", vbInformation
Exit Sub
Error:
MsgBox (err.Description)
Unload Me


End Sub

Stay tuned for real life practical solution developments. Subscribe so that you don`t miss any updates.

I hope you enjoyed this post.In case of any questions please leave your comments below or contact me directly.
Kindly like and share with your friends using the below buttons.