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
- Create SMTP Configuration Form
- Send Test Mail Button
- 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.
Control | Name | Caption |
Frame | Frame1 | SMTP Server Configuration |
Text Box | textServer | |
Text Box | textUser | |
Text Box | textPassword | |
Text Box | textPort | |
Combo Box | cboSSL | |
Combo Box | cboAuthenticate | |
Combo Box | cboSendUsing | |
Check Box | My server requires user authentication | |
Lable | Server | |
Lable | SMTP Uses SSL | |
Lable | SMTP Authenticate | |
Lable | User | |
Lable | Password | |
Lable | Send Using | |
Lable | SMTP Server Port | |
cmdSendTest | &Send Test Mail | |
cmdSave | &Save Configuration File |
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.
Leave a Reply