How to develop a commercial e-Statement solution in vb6 step by step – Part 11 – Create HTML Email Body In VB6

Create HTML Email E-statement Mailer

This is the most important part of the E-Statement Solution that we have been developing since we started. We can say it is the heart of the whole E-statement solution which will be responsible for sending out the Mass Emails to their respective email addresses.

Warning: This post is a continuation of previous posts and will not make sense if you have not been following the previous posts. You can start here

How the E-Statement Email Looks

Note that the E-Statement has different sections, see this post for more E-statement Email Body Sections

How the E-Statement Mailer works

Most E-Statements are in PDF forms which have already been generated by other systems. In this solution we will not look into how to generate PDF statements, but we will concentrate on how to send the generated PDF statements to their owners automatically at a click of a button.

Get Client Email Address

In this solution the PDFs will have the name of the ‘Account Number’ of the client. This will enable the solution to pick a PDF from a folder and using the PDF name search for the ‘Client Email Address(s)’ in the database and send it to them.

SmartMail – Clients Table

We can see the table structure for the Clients Table which we had created earlier, if you haven`t done so check this post  Smart Mail Database Structure

Send The E-statement To More Than One Person

We can also CC the same E-Statement to more than one person in case the account is managed by more than one person. (e.g Joint Accounts).

If we want to CC the mail to more than one person, we need to add the same Account Number in the database with the needed different email addresses and the solution will send the same PDF E-Statement to all the email addresses in the Clients Table for that particular account number.

Building The E-Statement Mailer

Add a new Form to your Project and Name it as “frmMailer” and Caption “E-Statement Mailer”

Add the following controls to the form.

Your form should look like below excluding the Smart Tech Diary Header.

Once we have completed designing our form, its time to start giving it the logic.

Source Code

Copy and paste the code below to your from. The code has comments for easier understanding.

'Module:E-Statement Mailer
'Series:How to develop a commercial e-Statement solution in vb6 
'Keywords:Send Mail in VB6 Using Gmail SMTP, Ping Using VB6,Create HTML Email,Ping Using VB6,Send Mail
'Developer:www.smarttechdiary.com


Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Integer, ByVal dwReserved As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Dim Fso As FileSystemObject
Dim num_files
Dim files() As String
Public Con As ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim processedItems As Integer
Dim sentItems As Integer
Dim unSentItems As Integer

Private Function PrintFiles(ByVal dir_path As String, _
  Optional ByVal exclude_self As Boolean = True, _
  Optional ByVal exclude_parent As Boolean = True) As _
      String()
      
  sentItems = 0
  unSentItems = 0
  processedItems = 0
  
'DELIVERY STATUS NOTIFICATIONs
      'Set DSN options.
'    Name                   Value       Description
'    cdoDSNDefault             0       No DSN commands are issued.
'    cdoDSNNever               1       No DSN commands are issued.
'    cdoDSNFailure             2       Return a DSN if delivery fails.
'    cdoDSNSuccess             4       Return a DSN if delivery succeeds.
'    cdoDSNDelay               8       Return a DSN if delivery is delayed.
'    cdoDSNSuccessFailOrDelay  14      Return a DSN if delivery succeeds, fails, or is delayed.



'Get SMTP Server Configurations from the database

    '----------------------Email Declarations and SMTP Server Configuration-------------------------------------
Dim imsg As Object
Dim iConf As Object
Dim Flds As Variant

  '------------------------------------------------------------------------------------------------------------
  '                            GET EMAIL BODY DETAILS FROM THE DATABASE
  ' =============================================================================================================
  
Dim MessageSubject As String 'Email Subject
Dim EmailStatementLogo As String 'Email Body Logo
Dim EmailAdvertImage As String 'Advert Message/Image
 
'E-Statement Subject
MessageSubject = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=8", "SettingValue")
'E-Statement Advert Image
EmailAdvertImage = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=9", "SettingValue")
'E-Statement Header Logo
EmailStatementLogo = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=10", "SettingValue")

  
'------------------------------------------------------------------------------------------------------------
  '                            EMAIL & SMTP SERVER SET UP
  ' =============================================================================================================

Dim objBP
Set imsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
'iMsg.AddRelatedBodyPart EmailAdvertImage, "Advert.png", cdoRefTypeId 'Advert Image
imsg.AddRelatedBodyPart EmailAdvertImage, "Advert", cdoRefTypeId 'Advert Image

Dim SSL As String
Dim Authenticate As String
Dim User As String
Dim Password As String
Dim Server As String
Dim SendUsing As String
Dim Port As String


SSL = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=1", "SettingValue")
Authenticate = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=2", "SettingValue")
User = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=3", "SettingValue")
Password = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=4", "SettingValue")
Server = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=5", "SettingValue")
SendUsing = getValueAt("SELECT SettingValue FROM AppSettings where  SettingID=6", "SettingValue")
Port = getValueAt("SELECT SettingValue FROM AppSettings where SettingID=7", "SettingValue")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = SSL
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Authenticate
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Password
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Server
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = SendUsing
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
.Update
End With
    

'------------------------------------------------------------------------------------------------------------
  '                            GET CUSTOMER ESTATEMENTS (.PDFs) FROM FOLDER
  '                            GET CUSTOMER EMAIL ADDRESS FROM THE DATABASE USING THE PDF NAME(PDF NAME = ACCOUNT)
  '
  ' =============================================================================================================

    Dim file_name As String

    file_name = Dir$(dir_path + "\")
    
    num_files = -1
    
    'Loop to add all the PDFs in the folder in an files()
    Do While Len(file_name) > 0
        
        If Not _
            (exclude_self And file_name = ".") Or _
            (exclude_parent And file_name = "..") _
        Then
            If Len(file_name) > 0 Then
            Set Fso = New FileSystemObject
            extn = Fso.GetExtensionName(file_name)
               If extn = "pdf" Then ' Pick Only PDF Files
                    num_files = num_files + 1
                    ReDim Preserve files(num_files)
                    files(num_files) = file_name
                End If
            End If
        End If
        file_name = Dir$()
    Loop

'Create a "Sent Items" Folder to put the sent PDFS

cfolder = dir_path + "Sent Items"
If Fso.FolderExists(cfolder) = False Then
    Fso.CreateFolder cfolder
End If

'Start Processing Each PDF Statement
For I = 0 To num_files
    InputFile = dir_path + files(I)
    Me.Caption = "No Of Files Processed:" & Str(I + 1)
    X = DoEvents
    Dim ret As Long
    
    'Handle 1 file error
    If num_files > 1 Then pb.Max = num_files
'--------------------------------------------
'            SEND EMAILS HERE
'--------------------------------------------

 'Path Declaration
 Dim fname As String
 fname = files(I)
 fname = Mid$(fname, 1, 7) 'Get Account No Only
 Dim path As String
 path = Command$
 path = cfolder + "\" + fname
 
 

  If Rs.State = 1 Then Rs.Close

   
  '------------------------------------------------------------------------------------------------------------
  '                            GET CLIENT(S) DETAILS FROM THE DATABASE
  ' =============================================================================================================
   
  Dim Clientname As String
  Dim Clientemail As String
  Dim ClientID As String
  Dim attachment As String
  Dim cc As String
  
   Clientemail = ""
   Clientname = ""
   cc = ""
   ccCount = ""
   
   With Rs
        .Open "SELECT * FROM Clients Where AccountNo='" & fname & "' ", CN, adOpenDynamic, adLockOptimistic
        If Not .BOF Then
          .MoveFirst
        End If
        
          Do While Not .EOF
             '- FIRST LOOP ADD MAIN EMAIL
             If Clientemail = "" Then Clientemail = Rs!Email
             If Clientname = "" Then Clientname = Rs!Name
            
             .MoveNext
              'Assign Other Emails as CC
             If Not Rs.EOF Then cc = Rs!Name & ";" & cc
             
          Loop
          
          .Close
           
    End With

    '-----------------------------------Prepare Attachment File------------------
    Dim sSourceFile As String
    Dim sDestination As String
    Dim oFSO As FileSystemObject
       Set oFSO = CreateObject("Scripting.FileSystemObject")
       sSourceFile = InputFile
       sDestination = dir_path & Mid$(files(I), 1, 11) '& Str(I + 1) & "20-13" & ".pdf"
       'MsgBox (sDestination)
       oFSO.MoveFile sSourceFile, sDestination
    
       attachment = sDestination 'add the renamed pdf attachement
   '------------------------------------End Attachment Preparation------------


Dim strHTML
'-------------------------------E-Statement HTML BODY----------------------------------------
strHTML = "<html>"
strHTML = strHTML & "<head>"
strHTML = strHTML & "<title>The Smart Tech Diary</title>"
strHTML = strHTML & "</head>"
strHTML = strHTML & "<body>"
strHTML = strHTML & "<table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""100%"" style=""width:100.0%"">"
strHTML = strHTML & "<tbody>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<div align=""center"">"
strHTML = strHTML & "<table border=""1"" cellspacing=""0"" cellpadding=""0"" width=""620"" style=""width:465.0pt;border:solid #cccccc 1.0pt"">"
strHTML = strHTML & "<tbody>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""border:none;padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""100%"" style=""width:100.0%"">"
strHTML = strHTML & "<tbody>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""> </p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<table border=""0"" cellspacing=""0""  cellpadding=""0"" width=""100%"" style=""width:100.0%"">"
strHTML = strHTML & "<tbody>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td width=""23"" style=""width:17.25pt;padding:0in 0in 0in 0in""></td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""><img width=""566"" height=""53"" src=""cid:HeaderLogo.png"" alt=""Smart Tech Diary""></p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td width=""10"" style=""width:7.5pt;padding:0in 0in 0in 0in""></td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""> </p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""100%"" style=""width:100.0%"">"
strHTML = strHTML & "<tbody>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td width=""8"" style=""width:6.0pt;padding:0in 0in 0in 0in""></td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p style=""line-height:140%""><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679"">Dear <b>" & Clientname & "</b>.,"
strHTML = strHTML & "</span></p>"
strHTML = strHTML & "<p style=""line-height:140%""><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679"">Your eStatement / transaction advice is attached and is ready for viewing (in Adobe Acrobat pdf format). You can save, view and print it at your convenience.</span></p><br>"
strHTML = strHTML & "<p style=""line-height:140%""><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679"">To provide security and confidentiality, password protection has been built in. When prompted for password, please enter your Account master number. This is a 7 digit number that forms a part of your Account Number.</span></p><br>"
strHTML = strHTML & "<p style=""line-height:140%""><strong><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#800000"">For example:</span></strong><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679""><br>"
strHTML = strHTML & "</span><strong><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#800000"">Account Number : 01234 XXXXXXX 12</span></strong><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679""><br>"

strHTML = strHTML & "</span><strong><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#0a82ad"">Password :XXXXXX</span></strong><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679""></span></p>"
strHTML = strHTML & "<p style=""line-height:140%""><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679"">Remember you can receive your statements at any email address of your choice, and you can choose between daily, weekly or monthly statements.For more information on how to register, visit our website or any of our branches.</span></p>"
strHTML = strHTML & "<p style=""line-height:140%""><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679"">As this is an automatically generated mail, please do not reply to this address. If you have any questions, wish to amend your details or unsubscribe, kindly contact our Call Center on </span><strong><span style=""line-height:140%;font-size:8.5pt;font-family:"Arial","sans-serif"""><a href=""tel:020%11111%222222"" value=""+254202222222"" style=""color: #800000"" target=""_blank"" >020 222 3333</a> or <a href=""tel:0732%44444%55555 "" value=""+254732188888 ""  style=""color: #800000"" target=""_blank"">0700 222 222 </a> or <a href=""tel:0703%02088%66666"" value=""+254703066666 "" style=""color: #800000"" target=""_blank"">0703066666 </a>.</span></strong><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679""></span></p>"
strHTML = strHTML & "<p style=""line-height:140%""><span style=""font-size:8.5pt;line-height:140%;font-family:"Arial","sans-serif";color:#747679""><br>"
strHTML = strHTML & "<br>"
strHTML = strHTML & "Yours Sincerely,<br>"
strHTML = strHTML & "The Smart Tech Diary.<br>"
strHTML = strHTML & "<a href=""https://www.smarttechdiary.com/"" target=""_blank""><span style=""color:#800000"">www.smarttechdiary.com</span></a>"
strHTML = strHTML & "</span></p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td width=""3"" style=""width:2.25pt;padding:0in 0in 0in 0in""></td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</tbody>"
strHTML = strHTML & "</table>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""> </p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""> </p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in""></td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""> </p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""> </p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""><img border=""0"" width=""566"" height=""223"" src=""cid:Advert"" alt=""Say yest to first rate forex""></p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""> </p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</tbody>"
strHTML = strHTML & "</table>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal""></p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td style=""background:#6d6e72;padding:3.75pt 0in 3.75pt 0in"">"
strHTML = strHTML & "<table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""100%"" style=""width:100.0%"">"
strHTML = strHTML & "<tbody>"
strHTML = strHTML & "<tr>"
strHTML = strHTML & "<td width=""23"" style=""width:17.25pt;padding:0in 0in 0in 0in""></td>"
strHTML = strHTML & "<td style=""padding:0in 0in 0in 0in"">"
strHTML = strHTML & "<p class=""MsoNormal"" style=""line-height:120%""><span style=""font-size:7.5pt;line-height:120%;font-family:"Arial","sans-serif";color:#d6d6d4"">This email is confidential and may also be privileged. if you are not the intended recipient, please notify us immediately;you should not copy or use it for any purpose nor disclose its contents to any other person Please be aware that there is a risk that information requested via email can be implemented to intercepted while enroute to your mailbox or seen by unauthenticated individuals if your mailbox security is inadequate E-Statements are your contribution towards a safer, cleaner environment. Thanks for playing your part. Save trees, protect the environment, do not print this mail.</span></p>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "<td width=""10"" style=""width:7.5pt;padding:0in 0in 0in 0in""></td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</tbody>"
strHTML = strHTML & "</table>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</tbody>"
strHTML = strHTML & "</table>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</tbody>"
strHTML = strHTML & "</table>"
strHTML = strHTML & "</div>"
strHTML = strHTML & "</td>"
strHTML = strHTML & "</tr>"
strHTML = strHTML & "</tbody>"
strHTML = strHTML & "</table>"
strHTML = strHTML & "</body>"
strHTML = strHTML & "</html>"

'------------------------------END E-Statement HTML BODY-------------------------------------

With imsg
Set .Configuration = iConf
.To = Clientemail
.cc = cc
.BCC = ""
' Note: The reply address
' you can add this line
' to change the reply address .ReplyTo = "Reply@something.com"
.From = "The Smart Tech Diary <smarttecdiary@gmail.com>"
.Subject = MessageSubject
  .HTMLBody = strHTML
  
   'DELIVERY STATUS NOTIFICATIONs
      'Set DSN options.
'    Name                   Value       Description
'    cdoDSNDefault             0       No DSN commands are issued.
'    cdoDSNNever               1       No DSN commands are issued.
'    cdoDSNFailure             2       Return a DSN if delivery fails.
'    cdoDSNSuccess             4       Return a DSN if delivery succeeds.
'    cdoDSNDelay               8       Return a DSN if delivery is delayed.
'    cdoDSNSuccessFailOrDelay  14      Return a DSN if delivery succeeds, fails, or is delayed.
'
'.Fields("urn:schemas:mailheader:disposition-notification-to") = "<smarttecdiary@gmail.com>" 'ToDo: Type a valid e-mail address.
'.Fields("urn:schemas:mailheader:return-receipt-to") = "<smarttecdiary@gmail.com>"  'ToDo: Type a valid e-mail address.
'.DSNOptions = cdoDSNSuccessFailOrDelay
'.DSNOptions = 14
'.Fields.Update
  
.Attachments.DeleteAll
'
  Set objBP = .AddRelatedBodyPart(EmailStatementLogo, "HeaderLogo.png", 1)
     objBP.Fields.Item("urn:schemas:mailheader:Content-ID") = "<HeaderLogo.png>"
     objBP.Fields.Update
     
'Attach The Client PDF E-Statement
.AddAttachment attachment

'Progress Bar
processedItems = processedItems + 1
lblProcessedItems.Caption = processedItems

'Error handling when the email is incorrect
 On Error GoTo ErrHandler
  
'Send the E-Statement to the SMTP Server For Further Action
.Send 'Send

  sentItems = sentItems + 1
  lblsentItems.Caption = sentItems
 
  
                       '--------Move Files To Sent Items Folder------
       sSourceFile = sDestination
       'MsgBox (sSourceFile)
       sDestination = cfolder & "\" & Mid$(files(I), 1, 11)
       'MsgBox (sDestination)
       oFSO.MoveFile sSourceFile, sDestination
    
       
   '------------------------------------End Moving--------------------------

 Exit Function
 
ErrHandler:
 '--------Move Files To Unsent Folder------

  'Call LogError("MySub", Err, Error$) ' passes name of current routine '
  Select Case err.Number
    Case "-2147220977"
         unSentItems = unSentItems + 1
         lblUnsentItems.Caption = unSentItems
    Open App.path & "/InvalidEmaillog.txt" For Append As #100
       Print #100, "Error Description:" & err.Description & "  " & "Client Name:" & Clientname
    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


'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'             END SEND
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
      
       'Progress Bar
       pb.Value = I
Next I
    
End Function

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdSend_Click()
'Check for internet connectivity before we procced

If (CheckInternetConnection = True) Then
    'Continue to send the emails
Else
    'Otherwise inform the user and exit
    MsgBox "Sorry you do not have an active Internet connection!", vbCritical
    Exit Sub
End If
    l = 1
    m = 1
    d = 1
    cmdSend.Enabled = False
    cmdSend.Caption = "Now sending..."
    PrintFiles dirSource.path + "\"
    
    MsgBox "Emailling Completed!", vbInformation
    cmdSend.Enabled = True
    cmdSend.Caption = "Start Sending"
    Close All
End Sub

Private Sub drvSource_Change()

    On Error GoTo errTrap

    dirSource.path = drvSource.Drive
    
    Exit Sub
    
errTrap:

    MsgBox "Drive / Device Not Found!", vbExclamation

End Sub


'Sub for error logging
Sub LogError(ProcName$, ErrNum&, ErrorMsg$)
  On Error GoTo ErrHandler
  Dim nUnit As Integer
  nUnit = FreeFile
  ' This assumes write access to the directory containing the program '
  ' You will need to choose another directory if this is not possible '
  Open App.path & App.EXEName & ".log" For Append As nUnit
  Print #nUnit, "Error in " & ProcName
  Print #nUnit, "  " & ErrNum & ", " & ErrorMsg
  Print #nUnit, "  " & Format$(Now)
  Print #nUnit,
  Close nUnit
  Exit Sub

ErrHandler:
  'Failed to write log for some reason.'
  'Show MsgBox so error does not go unreported '
  MsgBox "Error in " & ProcName & vbNewLine & _
    ErrNum & ", " & ErrorMsg
End Sub


'Fuction to check for internet connectivity
Public Function CheckInternetConnection() As Boolean
    Dim aux As String * 255
    Dim r As Long
    r = InternetGetConnectedStateEx(r, aux, 254, 0)
    If r = 1 Then
        CheckInternetConnection = True
    Else
        CheckInternetConnection = False
    End If
End Function

Up to this part I hope you have been enjoying the posts. I welcome any positive comments and suggestions. Until next time, take care. Please like and share if you find this information useful.