Dim strConn,Conn,RecObj,strSQL,currentStatus,strStatus,arrSubject(1),blnApproved Dim intCount,strDate : intCount = 0 Const Appending=8 strConn = "Provider=SQLOLEDB;Data Source=sql2014;Initial Catalog=SheddPark;User Id=sports;password=letmein@cliff64;" strSQL = "EXECUTE dbo.USP_ROSTER_NOTICES" Set Conn = CreateObject("adodb.Connection") With Conn .ConnectionString = strConn .Open End With Set RecObj = CreateObject("adodb.recordset") With RecObj .Open strSQL,Conn Do While .EOF = False If .Fields("PlayerCount") <= .Fields("RosterCountP") And .Fields("CoachCount") <= .Fields("RosterCountC") Then currentStatus = 1 Else currentStatus = 2 End If If .Fields("RosterStatus") <> currentStatus Or IsNull(.Fields("NoticeDate")) = True Then If currentStatus = 1 Then 'Team Approved blnApproved = "T" strDate = .Fields("LastAppUpdate") arrSubject(0) = "Congrats!: "&.Fields("SMOrg") & "-" & .Fields("TeamName") & " has been approved by "&.Fields("NameAbbr")&" for "&.Fields("Season") arrSubject(1) = .Fields("SMOrg")&"-"&.Fields("Season")&"-"&.Fields("League")&"-"&.Fields("TeamName")&" is approved by "&.Fields("NameAbbr") Call SendEmail(.Fields("TeamID"),blnApproved,.Fields("FormAbbr"),.Fields("SMOrgID"),.Fields("Approved"),.Fields("Disapproved")) Else blnApproved = "F" arrSubject(0) = "Note: "&.Fields("SMOrg") & "-" & .Fields("TeamName") & " is no longer approved by "&.Fields("NameAbbr")&" for "&.Fields("Season") arrSubject(1) = .Fields("SMOrg")&"-"&.Fields("Season")&"-"&.Fields("League")&"-"&.Fields("TeamName")&" is no longer approved by "& .Fields("NameAbbr") Call SendEmail(.Fields("TeamID"),blnApproved,.Fields("FormAbbr"),.Fields("SMOrgID"),.Fields("Approved"),.Fields("Disapproved")) End If strSQL= "UPDATE TeamNames SET RosterStatus="¤tStatus&",NoticeDate=GETDATE() WHERE TeamID="&.Fields("TeamID") Conn.Execute(strSQL) Else strSQL= "UPDATE TeamNames SET RosterStatus="¤tStatus&" WHERE TeamID="&.Fields("TeamID") Conn.Execute(strSQL) End If .MoveNext Loop End With RecObj.Close() : Set RecObj = Nothing : Conn.Close() : Set Conn = Nothing Set fs=CreateObject("Scripting.FileSystemObject") Set f=fs.OpenTextFile("C:\ScheduleTask\rosterLog.txt", Appending) f.Write VBCRLF&intCount&" Emails Sent Sucessfully At "&Now&VBCRLF&"------------------" f.close() Set fs=Nothing Sub SendEmail(ByVal Team,ByVal bln,ByVal FormAbbr,ByVal OrgID,ByVal blnNoticeApproved,ByVal blnNoticeDisApproved) Dim objMail,strSubject,RecMail,strCoachPlayer,strBody If bln="F" Then strCoachPlayer = PlayerCaoch(Team) Else strAttachment=PdfHtml(Team,FormAbbr) End If Set RecMail =CreateObject("adodb.recordset") With RecMail .Open "EXECUTE USP_COACH_APPROVER "&Team & "," & OrgID,Conn Do While .EOF =False If .Fields("RosterNotice") = 3 Then '***If Approver has both approved and disapproved intCount= intCount + 1 Set objMail=CreateObject("CDO.Message") With objMail .Subject=arrSubject(RecMail.Fields(2)) .From="SportsManager" .To=RecMail.Fields(1) .BCC = "Copy" If bln = "T" Then objMail.AddAttachment strAttachment End If .HTMLBody = strCoachPlayer .Send End With Set objMail=Nothing ElseIf .Fields("Type") = 1 And ((bln="T" And .Fields("RosterNotice")=1) Or (bln="F" And .Fields("RosterNotice")=2)) Then '**IF APPROVER HAS EITHER APPROVED OR DISAPPROVED intCount= intCount + 1 Set objMail=CreateObject("CDO.Message") With objMail .Subject=arrSubject(RecMail.Fields(2)) .From="SportsManager" .To=RecMail.Fields(1) .BCC = "Copy" If bln = "T" Then objMail.AddAttachment strAttachment End If .HTMLBody = strCoachPlayer .Send End With Set objMail=Nothing ElseIf ((blnNoticeApproved = True And bln="T") Or (blnNoticeDisApproved = True And bln="F")) And .Fields("Type") <> 1 Then '***CHECK APPROVED AND DISAPPROVED FOR COACHES ORG intCount= intCount + 1 Set objMail=CreateObject("CDO.Message") With objMail .Subject=arrSubject(RecMail.Fields(2)) .From="SportsManager" .To=RecMail.Fields(1) .BCC = "Copy" If bln = "T" Then objMail.AddAttachment strAttachment End If .HTMLBody = strCoachPlayer .Send End With Set objMail=Nothing End If .MoveNext Loop .Close() End With Set RecMail = Nothing If bln = "T" Then Set fs=CreateObject("Scripting.FileSystemObject") If fs.FileExists(strAttachment) Then fs.DeleteFile(strAttachment) End If Set fs=Nothing End If End Sub Function PlayerCaoch(ByVal Team) Dim RecList,SqlQuery,strTable SqlQuery = "EXECUTE dbo.USP_ROSTER_PLAYER_COACH "&Team Set RecList = CreateObject("adodb.recordset") With RecList .Open SqlQuery,Conn If .EOF = False Then strTable = "" Do While .EOF = False strTable = strTable &"" .MoveNext Loop strTable = strTable & "
"&.Fields("Type")&""&.Fields("First")&" "&.Fields("Last")&""&.Fields("Status")&"
" End If .Close() End With Set RecList = Nothing PlayerCaoch = strTable End Function Function PdfHtml(ByVal intTeam,ByVal Mode) Dim RecTeam,strTable,strFileName Dim SqlQuery If Mode="MAYSL" Then strHeader="MAYSL SOCCER APPROVED ROSTER" strOMORG="MAYSL" ElseIf Mode="MD" Then strOMORG="MYSL" strHeader="MIDDLESEX SOCCER APPROVED ROSTER" ElseIf Mode="NVYSL" Then strOMORG="NVYSL" strHeader="NVYSL SOCCER APPROVED ROSTER" End If Set RecTeam = CreateObject("adodb.recordset") SqlQuery = "EXECUTE dbo.USP_ROSTER_TEAM_INFO "&intTeam With RecTeam .Open SqlQuery,Conn If .EOF = False Then strTeam = .Fields("TeamName") strOrg = .Fields("OrgName") strLeague =.Fields("League") If .Fields("TeamNumber") <> "" Then strTeamID= .Fields("TeamNumber") Else strTeamID= .Fields("TeamID") End If strDiv = .Fields("Div") strColor = .Fields("TeamColor") If .Fields("LeagueGenders") = 1 Then strBoys = "X" strGirls = "X" strBG = "C" ElseIf .Fields("LeagueGenders") = 2 Then strBoys = "X" strGirls = "" strBG = "B" Else strBoys = "" strGirls = "X" strBG = "G" End If strAgeGroup = .Fields("MaxAge") + 1 If .Fields("TeamNumber") <> "" Then strTeamNumber = Replace(.Fields("TeamNumber"),"/","_") strTeamNumber = Replace(strTeamNumber,"\","_") Else strTeamNumber = Replace(.Fields("TeamName"),"/","_") strTeamNumber = Replace(strTeamNumber,"\","_") End If strPosition = .Fields("Pos") End If .Close() End With Set RecTeam = Nothing If Month(Date) < 10 Then strMonth = "0" & Month(Date) Else strMonth = Month(Date) End If If Day(Date) < 10 Then strDay = "0" & Day(Date) Else strDay = Day(Date) End If strFileName = strBG & strAgeGroup & "-" & strDiv & "-" & strTeamNumber & "-" & strMonth & strDay&"-"&intTeam&".pdf" strFileName = Replace(strFileName,":","") strTable = "" strTable = strTable & "" strTable = strTable & "" strTable = strTable & "" strTable = strTable & "
"&strHeader&"
Town/Club: "&strOrg&"Date: "& strDate & "Original: Change:
Team Name: "&strTeam&"Age: "&strLeague&"Girls: "&strGirls&"Boys: "&strBoys&"Shirt Color: "&strColor&"
League:Team ID#: "&strTeamID&"Div/Section: "&strDiv&"
" intNum = intNum+1 Set RecCoach = CreateObject("adodb.recordset") With RecCoach .Open "EXECUTE dbo.USP_TEAM_COACHES "&intTeam, Conn Do While .EOF = False strTable = strTable & "" intNum = intNum+1 .MoveNext Loop .Close() End With Set RecCoach = Nothing Do While intNum <=3 strTable = strTable & "" intNum = intNum+1 Loop intNum = 0 strTable = strTable & "
 CoachPhoneEmail
"&intNum&""&.Fields(0)&""&.Fields(2)&""&.Fields(1)&"
"&intNum&"   
" Set RecPlayer = CreateObject("adodb.recordset") With RecPlayer .Open "EXECUTE dbo.USP_TEAM_PLAYERS "&intTeam, Conn Do While .EOF = False intNum = intNum+1 strTable = strTable & "" .MoveNext Loop .Close() End With Set RecPlayer = Nothing strTable = strTable & "
 Shirt#Last NameFirst NameDOBTownAssigned
"&intNum&""&.Fields(0)&" "&.Fields(1)&""&.Fields(2)&""&.Fields(3)&""&.Fields(4)&""&.Fields(5)&"
Transfers:
" For I=1 To 3 strTable = strTable & "" Next strTable = strTable & "
"&I&"      
" strTable = strTable & "" If strOMORG <> "NVYSL" Then strTable = strTable & "" strTable = strTable & "" strTable = strTable & "" Else strTable = strTable & ApproverSignature(intTeam) End If strTable = strTable & "
"&strOMOrg&" Registrar Verification ______________________________________________Date ___________________
"&strOMOrg&" Boys/Com Verification ______________________________________________Date ___________________
"&strOMOrg&" Girls/Com Verification ______________________________________________Date___________________
"&strPosition&"'s SignatureClub/Town Certification
I Certify that I will comply with Soccer and bylaws, playing rules, & " & strPosition & "'s Code of Conduct, and know the penalties for non-compliance.

" & strPosition & "'s Signature ______________________		All players and all coaches/managers meet all Soccer requirements for affilation and playing age, and the town/club is properly affiliated.

Signature _______________________________
" strTable = strTable & " 
Referee:Sched. Date:Actual Date:
Opposing Team:Winner:Score:
" strTable = strTable & "" strFileName="C:\ScheduleTask\Attachment\"&strFileName Set Pdf = CreateObject("Persits.Pdf") Set doc = Pdf.CreateDocument Set Page = Doc.Pages.Add Set Image = Doc.OpenImage("C:\ScheduleTask\Approved.jpg") Set Param = Pdf.CreateParam Param("x") = 100 Param("y") = 200 Param("ScaleX") =2 Param("ScaleY") =2 Page.Background.DrawImage Image, Param Doc.ImportFromUrl strTable Doc.Save strFileName,True Set Pdf = Nothing PdfHtml = strFileName End Function Function ApproverSignature(ByVal TeamID) Dim strSignature,strSQL Set ObjFS=CreateObject("Scripting.FileSystemObject") strSQL ="EXECUTE dbo.USP_ROSTER_FORM_APPROVER_SIGNATURE " & TeamID & ",1" Set RecSignature = CreateObject("adodb.recordset") With RecSignature .Open strSQL,Conn If .EOF = False Then strSignature = "" Do While .EOF = False strLogo = "C:\inetpub\sportsmanager\"&Replace(.Fields(0),"/","\") If ObjFS.FileExists(strLogo) then strSignature = strSignature & "    " End If .MoveNext Loop strSignature = strSignature & "" End If End With Set RecSignature = Nothing : Set ObjFS = Nothing ApproverSignature = strSignature End Function