Sending email from access form (1 Viewer)

Private Sub CmdEmailPointsBalance_Click()
On Error GoTo Err_CmdEmailPointsBalance_Click
    
    Dim varTo As Variant                    'Email Address
    Dim stText As String                    'Email Text
    Dim stSubject As String                 'Email Subject Line
    Dim strSQL As String                    'SQL String
    Dim PointsAvailable As Integer          'Available Club Points
    Dim MembID As Integer                   'Member ID
    Dim PointsAll As Integer                'Total Club Points Variable
    Dim PointsCompleted As Integer          'Club Points for Completed Loans Variable
    Dim PointsPurchases As Integer          'Club Points Earned from Purchases Variable
    Dim PointsTraded As Integer             'Club Points Traded Variable
    Dim PointsPending As Integer            'Club Points Pending from Loans Not yet completed
    Dim FirstName As String                 'Club Member First Name as Variable
    Dim FullName As String                  'Club Member full Name as Variable
    Dim TeamMember As String                'Club Group Team Member Name as Variable
    Dim TeamID As String                    'Club Group Team Member ID as Variable
    Dim LoanID As String                    'Loan ID Variable
    Dim dbs As DAO.Database, rst As DAO.Recordset
    Set dbs = CurrentDb()
    
    MembID = Me.MemberID                    'set forms current Member ID to be variable value
    TeamID = UCase(CurrentUser())           'set TeamID as Current User
    TeamMember = TeamMemberName()           'set TeamMember to be function result
    PointsAll = GetMemClubPointsAll(MembID)
    PointsCompleted = GetMemClubPointsCompleted(MembID)
    PointsPurchases = GetMemPurchClubPoints(MembID)
    PointsTraded = GetMemPointsTraded(MembID)
    PointsPending = PointsAll - PointsCompleted
    PointsAvailable = Me.txtPointsBalance            'Set Forms Points Available to Use as variable value
    
        'SQL String to Collect Data
   strSQL = "SELECT TBLACCDET.ADPK, TBLACCDET.ADFirstname AS FirstName, [ADFirstname] & "" "" & [ADSurname] AS FullName, TBLACCDET.ADEmail AS EmailAdd " & _
        "FROM TBLACCDET " & _
        "WHERE (((TBLACCDET.ADPK)=" & MembID & "));"
            'Open Recordset
    Set rst = dbs.OpenRecordset(strSQL)
    FirstName = rst!FirstName   'Put Result of sql as Variable FirstName
    FullName = rst!FullName     'Put Result of sql as Variable FullName
    varTo = rst!EmailAdd        'Put Result of sql as Variable varTo

    If VarType(varTo) = 1 Then      'Check if Null Value for Email Address and if so, Exit Sub
        MsgBox "No Email Address Evident. Check your Data and update Email Address"
        Exit Sub
    End If
    
    stSubject = "Member Club Points Balance for: " & FullName & " - Member Number " & MemberIDFormat(CStr(MembID))

    stText = "Dear " & FirstName & "," & Chr(10) & Chr(10) & _
             "Your Total Club Points For All Loans is " & PointsAll & "." & Chr(13) & Chr(13) & Chr(10) & Chr(10) & _
             "Club Points Earned From Completed Loans To Date is " & PointsCompleted & "." & Chr(13) & Chr(10) & _
             "Plus Club Points Earned From Purchases " & PointsPurchases & "." & Chr(13) & Chr(10) & _
             "Less Club Points Traded To Date " & PointsTraded & "." & Chr(13) & Chr(10) & Chr(10) & _
             "Leaving You with " & PointsAvailable & " Club Points Available." & Chr(13) & Chr(10) & Chr(10) & _
             "You also have " & PointsPending & " Club Points Pending from Current Loans." & Chr(13) & Chr(10) & Chr(10) & _
             "Club Points can be used to purchase items from Selected businesses. Contact a Club Group Team Member for the current list. " & Chr(13) & Chr(10) & Chr(10) & _
             "Request a quote, in Your Name. Do Not have the quote in Club Group's name or it will be rejected. " & Chr(13) & Chr(10) & _
             "The quote does not have to be the same value as your Club Points total as any Club Points not used this time will be available for later use. " & Chr(13) & Chr(10) & _
             "If the quote is higher then your Club Points balance, then you will be asked to make a deposit into Club Group's bank account to cover the difference. " & Chr(13) & Chr(10) & Chr(10) & _
             "Fax or Email the quote to Club Group. Allow up to three working days for your Club Points Purchase to be processed. " & Chr(13) & Chr(10) & Chr(10) & _
             "Conditions Apply to Use of Club Points. Please contact a Club Group Team Member for Details. " & Chr(13) & Chr(10) & Chr(10) & _
             "Club Group contact details are: " & Chr(13) & Chr(10) & _
             ContactDetailBasic & Chr(13) & Chr(10) & Chr(10) & _
             "Kind Regards," & Chr(13) & Chr(10) & _
             TeamMember
     
    'Write the e-mail content for sending to assignee
    DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, -1
    
        'SQL to Find Last Current or Completed Loan ID
    strSQL = "SELECT TBLLOAN.ADPK, Max(TBLLOAN.LDPK) AS MaxOfLDPK " & _
        "FROM TBLLOAN " & _
        "WHERE ((Not (TBLLOAN.LDTerm)=5)) " & _
        "GROUP BY TBLLOAN.ADPK " & _
        "HAVING (((TBLLOAN.ADPK)=" & MembID & "));"
             'Open Recordset
    Set rst = dbs.OpenRecordset(strSQL)
    LoanID = rst!MaxOfLDPK   'Put Result of sql as Variable LoanID
    
    'Sql to add a Loan Communication record regarding Club Points Email Just Sent
    DoCmd.SetWarnings False         'Turn Warnings Off
    strSQL = "INSERT INTO tblCommunication ( RecordRef, OperatorID, RecordType, CommNotes ) " & _
        "SELECT " & LoanID & " AS RecordRef, " & Chr(34) & TeamID & Chr(34) & " AS OperatorID, ""Loan"" As RecordType, ""Emailed Club Points Advice."" AS CommNotes " & _
        "FROM TBLLOAN " & _
        "WHERE (((TBLLOAN.LDPK)=" & LoanID & "));"
    DoCmd.RunSQL strSQL      'Run SQL
    DoCmd.SetWarnings True          'Turn Warnings On
   
      'Close database variables
    rst.Close
    dbs.Close
    
Exit_CmdEmailPointsBalance_Click:
    Exit Sub

Err_CmdEmailPointsBalance_Click:
    MsgBox Err.Description
    Resume Exit_CmdEmailPointsBalance_Click

End Sub

     Dim strList As String
    
     strList = Me.ListName1.Column(X) & " " & Me.ListNAme2.Column(X)
     [COLOR="SeaGreen"] 'where X represent the column in your List box that hold the flavor  [/COLOR]
     DoCmd.SendObject acSendForm, , , "To@Hotmail.com", , , "Subject", strList