Private Sub CmdEmailMembBal_Click()
On Error GoTo Err_CmdEmailMembBal_Click
Dim dbs As DAO.Database, rst As DAO.Recordset
Dim varTo As Variant 'Email Address
Dim stText As String 'Email Text
Dim stSubject As String 'Email Subject Line
Dim stSubjectWeight As String 'Email Subject Weight Variable - Reminder etc
Dim stEmailOpen As String 'Email Open Variable
Dim stEmailClose As String 'Email Close Message Variable
Dim EmailText As String 'String to hold each loan details
Dim EmailBody As String 'String to accumulate the Loan Details
Dim strSQL As String 'SQL String
Dim PointsAvailable As Integer 'Available Club Points
Dim MembID As Integer 'Member ID
Dim FirstName As String 'Club Member First Name as Variable
Dim FullName As String 'Club Member full Name as Variable
Dim TeamID As String 'Club Group Team Member ID as Variable
Dim LastLoanID As String 'Last Loan Number held as variable
Dim LastRepayDate As Date 'Last Repayment Date Variable
Dim LastRepayAmt As Currency 'Last Repay Amount Variable
Dim TeamMember As String 'variable to hold Team Member Full Name
MembID = Me.txtADPK 'set forms current Member ID to be variable value
TeamID = UCase(CurrentUser()) 'set TeamID as Current User
TeamMember = TeamMemberName() 'put result of function as Team member Full Name
Set dbs = DBEngine(0)(0)
'SQL String to Collect Member Name, Email Address and Last Loan Number Data
strSQL = "SELECT TBLACCDET.ADPK, TBLACCDET.ADFirstname AS FirstName, [ADFirstname] & "" "" & [ADSurname] AS FullName, TBLACCDET.ADEmail AS varTo, Max(TBLLOAN.LDPK) AS MaxOfLDPK " & _
"FROM TBLACCDET INNER JOIN TBLLOAN ON TBLACCDET.ADPK = TBLLOAN.ADPK " & _
"GROUP BY TBLACCDET.ADPK, TBLACCDET.ADFirstname, [ADFirstname] & "" "" & [ADSurname], TBLACCDET.ADEmail " & _
"HAVING (((TBLACCDET.ADPK)=" & MembID & "));"
'Open Recordset
Set rst = dbs.OpenRecordset(strSQL)
FirstName = rst!FirstName 'Put Result of sql as Variable First Name
FullName = rst!FullName 'Put Result of sql as Variable Full Name
varTo = rst!varTo 'Put Result of sql as Variable Email Address
LastLoanID = rst!MaxOfLDPK 'Put reult of SQL as Variable Last Loan Number
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"
'Close database variables
rst.Close
dbs.Close
Exit Sub
End If
LastRepayDate = LastMembRepayDate(CStr(MembID)) 'Set Variable to be Result of Function
LastRepayAmt = LastMembRepayAmt(CStr(MembID)) 'Set Variable to be Result of Function
'SQL to Collect Loan Data for All Current Loans - Issued but not completed
strSQL = "SELECT TBLACCDET.ADPK, TBLLOAN.LDPK AS LoanID, TBLLOAN.LDTerm, TBLAPPLOAN.APLSTAT, tblLoanIssueStatus.IssueDate AS DateLoanIssued, TBLLOAN.LDPrin AS LoanPrincipal, TBLLOAN.LDPayK AS LoanRepayAmt, LastLoanRepayAmt(CStr([LoanID])) AS LastRepayAmt, IIf(LastLoanRepayDate(CStr([LoanID]))=#1/1/1995#,""NA"",LastLoanRepayDate(CStr([LoanID]))) AS LastRepayDate, Nz(QryLoanCurrentBalanceResult.LoanCurrentBalance,0) AS LoanOverdueAmt, Nz(QryLoanTotalToPayResult.SumOfLoanTotalToPay,0) AS LoanTotalToPay " & _
"FROM TBLAPPLOAN INNER JOIN (TBLACCDET INNER JOIN (tblLoanIssueStatus INNER JOIN ((TBLLOAN LEFT JOIN QryLoanTotalToPayResult ON TBLLOAN.LDPK = QryLoanTotalToPayResult.LoanID) LEFT JOIN QryLoanCurrentBalanceResult ON TBLLOAN.LDPK = QryLoanCurrentBalanceResult.LoanID) ON tblLoanIssueStatus.LoanID = TBLLOAN.LDPK) ON TBLACCDET.ADPK = TBLLOAN.ADPK) ON TBLAPPLOAN.APLPK = TBLLOAN.LoanAppID " & _
"WHERE (((TBLACCDET.ADPK)=" & MembID & ") AND ((TBLLOAN.LDTerm)=1) AND ((TBLAPPLOAN.APLSTAT)=3));"
'Open Recordset
Set rst = dbs.OpenRecordset(strSQL)
EmailBody = "Loan Principal Date Agreed Last Repay Overdue Total" & Chr(13) & Chr(10)
EmailBody = EmailBody & "Number Amount Issued Repayment Repayment Date Amount Amount" & Chr(13) & Chr(10)
Do Until rst.EOF
EmailText = LoanNumberFormat(rst!LoanID) & Space(15 - Len(LoanNumberFormat(rst!LoanID))) & Format(rst!LoanPrincipal, "Currency") & Space(15 - Len(Format(rst!LoanPrincipal, "Currency"))) & rst!DateLoanIssued & Space(15 - Len(rst!DateLoanIssued)) & Format(rst!LoanRepayAmt, "Currency") & Space(15 - Len(Format(rst!LoanRepayAmt, "Currency"))) & Format(rst!LastRepayAmt, "Currency") & Space(15 - Len(Format(rst!LastRepayAmt, "Currency"))) & rst!LastRepayDate & Space(15 - Len(rst!LastRepayDate)) & Format(rst!LoanOverdueAmt, "Currency") & Space(15 - Len(Format(rst!LoanOverdueAmt, "Currency"))) & Format(rst!LoanTotalToPay, "Currency") & Chr(13) & Chr(10)
EmailBody = EmailBody & EmailText
rst.MoveNext
Loop
If LastRepayDate > Date - 15 Then
stSubjectWeight = "Friendly Reminder"
stEmailOpen = "Dear "
stEmailClose = "Kind Regards,"
ElseIf LastRepayDate < Date - 45 Then
stSubjectWeight = "Promised Repayment Overdue"
stEmailOpen = ""
stEmailClose = "Please Respond Urgently,"
Else
stSubjectWeight = "Reminder"
stEmailOpen = ""
stEmailClose = "Regards,"
End If
PointsAvailable = GetMemClubPointsAvailable(MembID) 'Set Function Result as variable value
stSubject = stSubjectWeight & " - Member Loan Balances Details for " & FullName & " - Member Number " & MemberIDFormat(CStr(MembID))
stText = stEmailOpen & FirstName & "," & Chr(10) & Chr(10) & _
"Our Records show your Current Loan Details with Club Group Limited are as follows:" & Chr(13) & Chr(10) & Chr(10) & _
EmailBody & Chr(13) & Chr(10) & Chr(10) & _
"Your Club Points Balance is " & PointsAvailable & Chr(13) & Chr(10) & Chr(10) & _
stEmailClose & Chr(13) & Chr(10) & _
TeamMember & Chr(10) & Chr(10) & _
ContactDetailBasic & Chr(10) & Chr(10) & _
SeasonMessage
'Write the e-mail content for sending to assignee
DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, -1
'Sql to add a Loan Communication record regarding Loan Balances Email Just Sent
DoCmd.SetWarnings False 'Turn Warnings Off
strSQL = "INSERT INTO tblCommunication ( RecordRef, OperatorID, RecordType, CommNotes ) " & _
"SELECT " & LastLoanID & " AS RecordRef, " & Chr(34) & TeamID & Chr(34) & " AS OperatorID, ""Loan"" As RecordType, ""Emailed Member All Loans Balance Advice."" AS CommNotes " & _
"FROM TBLLOAN " & _
"WHERE (((TBLLOAN.LDPK)=" & LastLoanID & "));"
DoCmd.RunSQL strSQL 'Run SQL
DoCmd.SetWarnings True 'Turn Warnings On
'Close database variables
rst.Close
dbs.Close
Exit_CmdEmailMembBal_Click:
Exit Sub
Err_CmdEmailMembBal_Click:
MsgBox Err.Description
Resume Exit_CmdEmailMembBal_Click
End Sub
