On Error Resume Next Dim strConn,Conn,RecObj,strSQL,currentStatus,strStatus,arrSubject(1),blnApproved Dim intCount,strDate : intCount = 0 Dim arrCoachPics(4) Dim arrCoachEmail(4) Dim arrCoachName(4) Dim arrCoachPhone(4) Const Appending=8 '***EMAIL CONSTANT Const cdoContentDisposition = "urn:schemas:mailheader:content-disposition" Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing" Const cdoSendUsingPort = 2 Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver" Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport" Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout" Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" Const cdoBasic = 1 Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername" Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword" Const EMAIL_FORM = "donotreply@sportsmgr.us" strConn = "Provider=SQLOLEDB;Data Source=WIN-59JDF64IOMC;Initial Catalog=cloudspo_sportsmgr;User Id=cloudspo_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 For I=1 To 4 arrCoachPics(I) = "" : arrCoachEmail(I) = "" : arrCoachName(I) = "" : arrCoachPhone(I) = "" Next 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 'strAttachment = PdfHtmlWithPicture(127683,"MAYSL",455) 'Call SendEmail(127683,"T","MAYSL-PICS",455,"T","F") 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 If UCase(FormAbbr) <> "MAYSL-PICS" Then strAttachment=PdfHtml(Team,FormAbbr) ElseIf UCase(FormAbbr) = "MYSL-PICS" Then strAttachment=PdfHtmlWithPicture(Team,"MYSL",OrgID) ElseIf UCase(FormAbbr) = "MAYSL-PICS" Then strAttachment=PdfHtmlWithPicture(Team,"MAYSL",OrgID) End If 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 '***SEND EMAIL Set objConfig = CreateObject("CDO.Configuration") Set Fields = objConfig.Fields With Fields .Item(cdoSendUsingMethod) = cdoSendUsingPort .Item(cdoSMTPServer) = "mail.sportsmgr.us" .Item(cdoSMTPServerPort) = 25 .Item(cdoSMTPAuthenticate) = cdoBasic .Item(cdoSendUserName) = "donotreply@sportsmgr.us" .Item(cdoSendPassword) = "Shadow@1958" .Item(cdoSMTPConnectionTimeout) = 10 .Update End With Set objMail=CreateObject("CDO.Message") Set objMail.Configuration = objConfig With objMail .Subject=arrSubject(RecMail.Fields(2)) .From="SportsManager" .To=RecMail.Fields(1) '.BCC = "Copy;bhartiya.ravi@gmail.com" 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 '***SEND EMAIL Set objConfig = CreateObject("CDO.Configuration") Set Fields = objConfig.Fields With Fields .Item(cdoSendUsingMethod) = cdoSendUsingPort .Item(cdoSMTPServer) = "mail.sportsmgr.us" .Item(cdoSMTPServerPort) = 25 .Item(cdoSMTPAuthenticate) = cdoBasic .Item(cdoSendUserName) = "donotreply@sportsmgr.us" .Item(cdoSendPassword) = "Shadow@1958" .Item(cdoSMTPConnectionTimeout) = 10 .Update End With Set objMail=CreateObject("CDO.Message") Set objMail.Configuration = objConfig With objMail .Subject=arrSubject(RecMail.Fields(2)) .From="SportsManager" .To=RecMail.Fields(1) '.BCC = "bhartiya.ravi@gmail.com" 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 '***SEND EMAIL Set objConfig = CreateObject("CDO.Configuration") Set Fields = objConfig.Fields With Fields .Item(cdoSendUsingMethod) = cdoSendUsingPort .Item(cdoSMTPServer) = "mail.sportsmgr.us" .Item(cdoSMTPServerPort) = 25 .Item(cdoSMTPAuthenticate) = cdoBasic .Item(cdoSendUserName) = "donotreply@sportsmgr.us" .Item(cdoSendPassword) = "Shadow@1958" .Item(cdoSMTPConnectionTimeout) = 10 .Update End With Set objMail=CreateObject("CDO.Message") Set objMail.Configuration = objConfig 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" ElseIf Mode="PVJSL" Then strOMORG="PVJSL" strHeader="PVJSL 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 strHeader = strHeader & "
" & .Fields("Season") & " - " & Year(Date()) 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:\HostingSpaces\cloudspo\sportsmgr.us\wwwroot\"&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 Function PdfHtmlWithPicture(ByVal TeamID,ByVal Mode,ByVal OrgID) Dim RecTeam,strTable,strFileName Dim SqlQuery If Mode="MAYSL" Then strHeader="MIDLAND AREA YOUTH SOCCER APPROVED ROSTER" strOMORG="MAYSL" ElseIf Mode="MD" Then strOMORG="MYSL" strHeader="MIDDLESEX YOUTH SOCCER LEAGUE APPROVED ROSTER" ElseIf Mode="NVYSL" Then strOMORG="NVYSL" strHeader="NASHOBA VALLEY YOUTH SOCCER LEAGUE APPROVED ROSTER" ElseIf Mode="PVJSL" Then strOMORG="PVJSL" strHeader="PIONEER VALLEY JUNIOR SOCCER LEAGUE APPROVED ROSTER" End If Set RecTeam = CreateObject("adodb.recordset") SqlQuery = "EXECUTE dbo.USP_ROSTER_TEAM_INFO "&TeamID With RecTeam .Open SqlQuery,Conn If .EOF = False Then strHeader = strHeader & "
" & .Fields("Season") & " - " & Year(Date()) 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&"-"&TeamID&".pdf" strFileName = Replace(strFileName,":","") If blnApproved = "T" Then '***ROSTER IS Approved strSQL = "SELECT CONVERT(VARCHAR(10),MAX(AppUpdate),101) AS ApprovedDate FROM RosterApp WHERE (TeamID = " & TeamID & ")" Set RecObj = CreateObject("adodb.recordset") With RecObj .Open strSQL,Conn If .EOF = False Then strDate = "Apprvd: " & .Fields(0) Else strDate = "Date: " & Date End If .Close() End With Set RecObj = Nothing Else strDate = "Date: " & Date End If strTable = "" strTable = strTable & "" strTable = strTable & "" Set dicPlayers=CreateObject("Scripting.Dictionary") Set RecPlayers = CreateObject("ADODB.Recordset") strSQL = "EXECUTE dbo.USP_ROSTER_FORM_DISPLAY_PLAYERS_TASK_PROGRAM "&TeamID With RecPlayers .Open strSQL,Conn If .EOF = False Then Do While .EOF = False arrImg = ShowPlayerImagePlayer(RecPlayers.Fields("ThumbPhoto")) dicPlayers.Add CStr(.Fields("PlayerID")),arrImg .MoveNext Loop End If .Close() End With Set RecPlayers = Nothing arrPlayerKeys = dicPlayers.Keys arrPlayerImages = dicPlayers.Items strTable = strTable & "" strTable = strTable & "" strTable = strTable & "
"&strHeader&"
" strTable = strTable & "" strTable = strTable & "" strTable = strTable & "" strTable = strTable & "" strTable = strTable & "" strTable = strTable & "" strTable = strTable & "
Town/Club: "&strOrg&""& strDate & "Original: Change:
Team Name: "&strTeam&"Age: "&strLeague&"Girls: "&strGirls&"Boys: "&strBoys&"Shirt Color: "&strColor&"
League:Team ID#: "&strTeamID&"Div/Section: "&strDiv&"
" jaja = 0 strSQL = "EXECUTE dbo.USP_TEAM_INFO_TASK_PROGRAM " & TeamID & "," & OrgID jaja = 0 Set RecJA = CreateObject("adodb.recordset") With RecJA .Open strSQL,Conn Do While .EOF= False arrCoachName(jaja) = RecJA("Name") If RecJA("phcell") = "" Then strPhone = RecJA("phhome") Else strPhone = RecJA("phcell") End If If strPhone = "" Then strPhone = " " End If arrCoachPhone(jaja) = strPhone arrCoachEmail(jaja) = RecJA("email") arrCoachPics(jaja) = ShowCoachImage(.Fields("Photo")) jaja = jaja + 1 .MoveNext Loop End With Set RecJA = Nothing intNum = 0 strTable = strTable & "
 CoahPhoneEmail1234
1"&arrCoachName(0)&""&arrCoachPhone(0)&""&arrCoachEmail(0)&""&arrCoachPics(0)&""&arrCoachPics(1)&""&arrCoachPics(2)&""&arrCoachPics(3)&"
2"&arrCoachName(1)&""&arrCoachPhone(1)&""&arrCoachEmail(1)&"
3"&arrCoachName(2)&""&arrCoachPhone(2)&""&arrCoachEmail(2)&"
4"&arrCoachName(3)&""&arrCoachPhone(3)&""&arrCoachEmail(3)&"
" strTable = strTable & "
" strTable = strTable & "" If blnForceGrade = "T" Then strTable = strTable & "" End If strTable = strTable & "" strTable = strTable & "" Set RecPlayer = CreateObject("adodb.recordset") With RecPlayer .Open "EXECUTE dbo.USP_TEAM_PLAYERS "&TeamID, Conn Do While .EOF = False pc = pc + 1 If pc = 1 Or pc = 4 Or pc = 7 Or pc = 10 Or pc = 13 Or pc = 16 Or pc = 19 Or pc = 22 Or pc =25 Or pc = 28 Or pc = 31 Or pc = 34 Then intPicNum = 1 strTable = strTable & "" If blnForceGrade = "T" Then strTable = strTable & "" End If strTable = strTable & "" If pcImgNum+1 <= UBound(arrPlayerImages) Then strTable = strTable & "" Else strTable = strTable & "" End If If pcImgNum+2 <= UBound(arrPlayerImages) Then strTable = strTable & "" Else strTable = strTable & "" End If strTable = strTable & "" Else strTable = strTable & "" If blnForceGrade = "T" Then strTable = strTable & "" End If strTable = strTable & "" End If pcImgNum = pcImgNum + 1 : intPicNum = intPicNum + 1 .MoveNext Loop End With strTable = strTable & "
 Shirt#LastNameFirstNameDOBGrade123Town
"&pc&"-"&intPicNum&""&.Fields("UniformNumber")&""&.Fields("Last")&""&.Fields("First")&""&.Fields("birthday")&""&.Fields("Grade") & ""&arrPlayerImages(pcImgNum)&""&arrPlayerImages(pcImgNum+1)&" "&arrPlayerImages(pcImgNum+2)&" "&.Fields("City")&"
"&pc&"-"&intPicNum&""&.Fields("UniformNumber")&""&.Fields("Last")&""&.Fields("First")&""&.Fields("birthday")&""&.Fields("Grade") & ""&.Fields("City")&"
" strTable = strTable & "" If strOMORG <> "NVYSL" Then strTable = strTable & "" strTable = strTable & "" strTable = strTable & "" Else strTable = strTable & ApproverSignature(TeamID) 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 _______________________________
 
Referee:Sched. Date:Actual Date:
Opposing Team:Winner:Score:
" 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 PdfHtmlWithPicture = strFileName End Function Function ShowCoachImage(strImage) If IsNull(strImage) = True Or strImage = "" Then ShowCoachImage = "Missing Photo" Exit Function End If If IsPhotoExists(strImage) = True Then ShowCoachImage = "" Else ShowCoachImage = "Missing Photo" End If End Function Function ShowPlayerImagePlayer(strImage) If IsNull(strImage) = True Or strImage = "" Then ShowPlayerImagePlayer = "Missing Photo" Exit Function End If If IsPhotoExists(strImage) = True Then ShowPlayerImagePlayer = "" Else ShowPlayerImagePlayer = "Missing Photo" End If End Function Function IsPhotoExists(strPhoto) Set ObjFS=CreateObject("Scripting.FileSystemObject") IsPhotoExists = ObjFS.FileExists(strPhoto) End Function