THEO TODMAN’S BRIDGE WEBSITES CODE PAGES



This Page provides a jumping-off point for the VBA Code that generates my Bridge Websites.

Table of Code Documentation Location 37 (4 items)

Mini_Website_GEN_ClickChess_pgn_PageWeb_Page_Control_Club_70sParse_WebPage_JeffSmith_Teams

To access information, click on one of the links in the table above.

Go to top of page




Source Code of: Chess_pgn_Page
Procedure Type: Public Function
Module: Chess
Lines of Code: 113
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Chess_pgn_Page(ID)
0002Dim strOutputFolder As String
0003Dim strOutputFile As String
0004Dim strLine As String
0005Dim rsTableControl As Recordset
0006Dim rsTableControl2 As Recordset
0007Dim fsoTextFileChess As FileSystemObject
0008Dim tsTextFileChess As TextStream
0009Dim j As Integer
0010Dim FileName As String
0011Dim iFields As Integer
0012Dim strControlQuery As String
0013Dim rsFooterControl As Recordset
0014Dim x
0015Dim strPrevious_ID As String
0016Dim strNext_ID As String
0017Dim iPrevious_ID As Integer
0018Dim iNext_ID As Integer
0019Dim strQuery As String
0020'Read Data
0021 strQuery = "SELECT Chess_Results.ID, Chess_Results.Game_Comment, Chess_Results.pgn_File, Chess_Results.pgn4web_String, ChessDotCom_Link FROM Chess_Results WHERE (((Chess_Results.ID)=" & ID & "));"
0022Set rsTableControl2 = CurrentDb.OpenRecordset(strQuery)
0023If rsTableControl2.EOF Then
0024 Chess_pgn_Page = "Invalid ID"
0025 Exit Function
0026Else
0027 If rsTableControl2(3) & "" = "" Then
0028 Chess_pgn_Page = "No Data"
0029 Exit Function
0030 End If
0031End If
0032 strQuery = "SELECT Max(Chess_Results.ID) AS MaxOfID FROM Chess_Results WHERE (((Chess_Results.ID)<" & ID & "));"
0033Set rsTableControl = CurrentDb.OpenRecordset(strQuery)
0034If rsTableControl.EOF Then
0035 iPrevious_ID = 0
0036Else
0037 rsTableControl.MoveFirst
0038 If rsTableControl.Fields(0) & "" = "" Then
0039 iPrevious_ID = 0
0040 Else
0041 iPrevious_ID = rsTableControl.Fields(0)
0042 End If
0043End If
0044 strQuery = "SELECT Min(Chess_Results.ID) AS MinOfID FROM Chess_Results WHERE (((Chess_Results.ID)>" & ID & "));"
0045Set rsTableControl = CurrentDb.OpenRecordset(strQuery)
0046If rsTableControl.EOF Then
0047 iNext_ID = 0
0048Else
0049 rsTableControl.MoveFirst
0050 If rsTableControl.Fields(0) & "" = "" Then
0051 iNext_ID = 0
0052 Else
0053 iNext_ID = rsTableControl.Fields(0)
0054 End If
0055End If
0056strOutputFolder = "C:\Theo's Files\Websites\Theo's Website\Chess\"
0057Set fsoTextFileChess = New FileSystemObject
0058FileName = "Chess_Results_Theo_pgn_" & ID
0059FileName = FileName & ".htm"
0060strOutputFile = strOutputFolder & FileName
0061Set tsTextFileChess = fsoTextFileChess.CreateTextFile(strOutputFile, True)
0062strLine = "<!DOCTYPE html><HTML lang=""en"">"
0063strLine = strLine & "<HEAD><meta charset=""utf-8""><TITLE>Theo Todman's Chess Results Webpages</TITLE><link href=""../TheosStyle.css"" rel=""stylesheet"" type=""text/css""><link rel=""shortcut icon"" href=""../TT_ICO.png"" /></HEAD><BODY><H1>Theo Todman's Chess Games</H1><CENTER>"
0064tsTextFileChess.WriteLine strLine
0065If iPrevious_ID = 0 Then
0066 strPrevious_ID = "&larr; None"
0067Else
0068 strPrevious_ID = "&larr; <A Href=""Chess_Results_Theo_pgn_" & iPrevious_ID & ".htm"" TARGET =""_top"">Game " & iPrevious_ID & "</A>"
0069End If
0070If iNext_ID = 0 Then
0071 strNext_ID = "None &rarr;"
0072Else
0073 strNext_ID = "<A Href=""Chess_Results_Theo_pgn_" & iNext_ID & ".htm"" TARGET =""_top"">Game " & iNext_ID & "</A> &rarr;"
0074End If
0075strLine = "<CENTER> <TABLE class = ""Bridge"" WIDTH=450> <TR> <TH WIDTH=""33%"">" & strPrevious_ID & "</TH> <TH WIDTH=""34%""><H3>Game " & ID & "</H3></TH> <TH WIDTH=""33%"">" & strNext_ID & "</TH> </TR> </TABLE> <p>&nbsp;</p></CENTER> "
0076tsTextFileChess.WriteLine strLine
0077strLine = rsTableControl2(3)
0078tsTextFileChess.WriteLine strLine
0079'Footer
0080strLine = "</CENTER>"
0081tsTextFileChess.WriteLine strLine
0082strLine = "<hr><p>Hovering the mouse-pointer over the chessboard squares pops-up what clicking that square does. <b>The most important is E7, which flips the board</b>. 'Help' is H8. </p>"
0083tsTextFileChess.WriteLine strLine
0084If rsTableControl2(1) & "" <> "" Then
0085 strLine = "<hr><p>" & rsTableControl2(1) & "</p>"
0086 tsTextFileChess.WriteLine strLine
0087End If
0088If rsTableControl2(2) & "" <> "" Then
0089 strLine = "<hr><p>The PGN file below is made available for pasting into your favourite analysis engine. </p>" & rsTableControl2(2)
0090 tsTextFileChess.WriteLine strLine
0091 If rsTableControl2(4) & "" <> "" Then
0092 strLine = "<p>For analysis on Chess.com, follow <a href=""" & rsTableControl2(4) & """>This Link</a>. </p>"
0093 tsTextFileChess.WriteLine strLine
0094 End If
0095End If
0096strLine = "<hr><p>Generated using <a href=""http://pgn4web-board-generator.casaschi.net/board-generator.html"">pgn4web Board Generator</a>, default options except horizontal rather than vertical layout, and Standard Control Buttons. </p>"
0097tsTextFileChess.WriteLine strLine
0098'Page Footer
0099strLine = ""
0100strControlTable = "Chess"
0101 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Footer"")) ORDER BY Website_Control.Line;"
0102Set rsFooterControl = CurrentDb.OpenRecordset(strControlQuery)
0103rsFooterControl.MoveFirst
0104Do While Not rsFooterControl.EOF
0105 strLine = strLine & rsFooterControl.Fields(0)
0106 OK = Replace_Timestamp(strLine)
0107 rsFooterControl.MoveNext
0108Loop
0109tsTextFileChess.WriteLine strLine
0110 OK = CopyToTransfer(strOutputFolder, FileName)
0111Set tsTextFileChess = Nothing
0112Chess_pgn_Page = "OK"
0113End Function

Procedures Calling This Procedure (Chess_pgn_Page) Procedures Called By This Procedure (Chess_pgn_Page) Tables / Queries / Fragments Directly Used By This Procedure (Chess_pgn_Page) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



Source Code of: Mini_Website_GEN_Click
Procedure Type: Private Sub
Module: Form_Bridge
Lines of Code: 58
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub Mini_Website_GEN_Click()
0002Dim start As Date
0003Dim job_end As Date
0004Dim strQuery As String
0005Dim rsAdvert As Recordset
0006Dim FirstClub As String
0007Dim LastClub As String
0008 strQuery = "SELECT Clubs.Club, Clubs.Advert_1, Clubs.Advert_2, Clubs.Advert_Expiry FROM Clubs WHERE (((Clubs.Advert_Expiry)<Now())) ORDER BY Clubs.Club;"
0009Set rsAdvert = CurrentDb.OpenRecordset(strQuery)
0010If Not rsAdvert.EOF Then
0011 rsAdvert.MoveFirst
0012 FirstClub = rsAdvert.Fields(0)
0013 rsAdvert.MoveLast
0014 LastClub = rsAdvert.Fields(0)
0015 If FirstClub = LastClub Then
0016 FirstClub = " " & FirstClub
0017 Else
0018 FirstClub = "s" & FirstClub & " ... " & LastClub
0019 End If
0020 DoCmd.OpenTable ("Clubs")
0021 MsgBox ("Expired Adverts for Club" & FirstClub & ". Please fix. ")
0022End If
0023'Recreate the Club_Session_LPs table
0024 DoCmd.RunSQL ("DELETE * FROM Club_Session_LPs;")
0025 DoCmd.OpenQuery ("Club_Session_LPs_GEN")
0026If [Forms]![Bridge]![selClub] & "" = "" Then
0027 start = Now()
0028 If MsgBox("Run the Lot?", vbYesNo) = vbYes Then
0029 automatic_processing = "Yes"
0030 Web_Page_Control_Club_Results ("AnnOwen")
0031 Web_Page_Control_Club_Results ("Apple")
0032 Web_Page_Control_Club_Results ("BernieMon")
0033 Web_Page_Control_Club_Results ("BernieTues")
0034 Web_Page_Control_Club_Results ("BernieWeds")
0035 Web_Page_Control_Club_Results ("BernieThurs")
0036 Web_Page_Control_Club_Results ("BernieThursNF")
0037 Web_Page_Control_Club_Results ("BernieFri")
0038 Web_Page_Control_Club_Results ("BernieFriNF")
0039 Web_Page_Control_Club_Results ("BernieSat")
0040 Web_Page_Control_Club_Results ("Burstead")
0041 Web_Page_Control_Club_Results ("Hutton")
0042 Web_Page_Control_Club_Results ("HuttonUnion")
0043 Web_Page_Control_Club_Results ("Jubilee")
0044 Web_Page_Control_Club_Results ("Mayflower")
0045 Web_Page_Control_Club_Results ("Pilgrim")
0046 Web_Page_Control_Club_Results ("StEdiths")
0047 Else
0048 MsgBox ("Select a club then")
0049 End
0050 End If
0051Else
0052 automatic_processing = "No"
0053 start = Now()
0054 Web_Page_Control_Club_Results ([Forms]![Bridge]![selClub])
0055End If
0056job_end = Now()
0057MsgBox ("Mini-websites output in " & Round((job_end - start) * 24 * 60 * 60, 0) & " seconds.")
0058End Sub

Procedures Called By This Procedure (Mini_Website_GEN_Click) Tables / Queries / Fragments Directly Used By This Procedure (Mini_Website_GEN_Click) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



Source Code of: Parse_WebPage_JeffSmith_Teams
Procedure Type: Public Sub
Module: ScorebridgeConvertion
Lines of Code: 203
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Parse_WebPage_JeffSmith_Teams(strLine, Club, strDateTemp)
0002'Joint Project database - Jeff Smith Teams (doesn't retain all Teams info & can't calculate %ages)
0003' ... Code based on Parse_WebPage_Scorebridge_Teams
0004Dim strTemp As String
0005Dim strQry As String
0006Dim zapDate As String
0007Dim iTableStart As Long
0008Dim iTableEnd As Long
0009Dim iRowStart As Long
0010Dim iRowEnd As Long
0011Dim strBoards As String
0012Dim i As Long
0013Dim j As Long
0014Dim k As Long
0015Dim strPosition As String
0016Dim strPairNo As String
0017Dim strPair As String
0018Dim strName1 As String
0019Dim strName2 As String
0020Dim strScore As String
0021Dim strTops As String
0022Dim strPercent As String
0023Dim strMpts As String
0024Dim strSSlams As String
0025Dim strGSlams As String
0026Dim strPair2 As String
0027Dim strName3 As String
0028Dim strName4 As String
0029Dim Orientation As String
0030Dim strContinue As String
0031Dim strBoard As String
0032'Clear the previous run from the database
0033zapDate = FormatDateTime(strDateTemp, vbLongDate)
0034Debug.Print zapDate
0035 strQry = "DELETE Joint_Project_Results.*, Joint_Project_Results.Club, Joint_Project_Results.Session_Date FROM Joint_Project_Results WHERE (((Joint_Project_Results.Club)=""" & Club & """) AND ((Joint_Project_Results.Session_Date)=#" & zapDate & "#));"
0036DoCmd.RunSQL strQry
0037'Find number of boards ... (don't think needed, so just default
0038strBoards = 30
0039'Find if two lists (NS & EW)
0040i = InStr(strLine, "North / South")
0041If i > 0 Then
0042 Orientation = "NS"
0043Else
0044 Orientation = "NW" 'Dummy orientation
0045End If
0046iTableEnd = 1
0047strContinue = "Yes"
0048Do While strContinue = "Yes"
0049 strContinue = "No"
0050 iTableStart = InStr(iTableEnd, strLine, "<H4> <br> Director:")
0051 iTableStart = InStr(iTableStart, strLine, "<TR BGCOLOR")
0052 iTableStart = InStr(iTableStart + 1, strLine, "<TR BGCOLOR") 'Hop over title row
0053 iTableEnd = InStr(iTableStart, strLine, "</TABLE>")
0054 i = iTableStart
0055 iRowEnd = iTableStart
0056 iRowStart = InStr(iRowEnd, strLine, "<TR")
0057 Do Until i > iTableEnd
0058 iRowEnd = InStr(iRowStart, strLine, "</TR>")
0059 i = InStr(i + 1, strLine, "<TD")
0060 i = InStr(i + 1, strLine, ">")
0061 j = InStr(i, strLine, "</TD>")
0062 strPosition = Trim(Mid(strLine, i + 1, j - i - 1))
0063 i = InStr(i + 1, strLine, "<TD")
0064 i = InStr(i + 1, strLine, "A HREF")
0065 i = InStr(i + 1, strLine, ">")
0066 j = InStr(i, strLine, "</A>")
0067 strPairNo = Trim(Mid(strLine, i + 1, j - i - 1)) 'Really "TeamNo"
0068 'Pair 1
0069 i = InStr(i + 1, strLine, "<TD")
0070 i = InStr(i + 1, strLine, ">")
0071 j = InStr(i + 1, strLine, "</TD>")
0072 strPair = Trim(Mid(strLine, i + 1, j - i - 1)) 'Actually contains two pairs
0073 k = InStr(strPair, ",")
0074 strName1 = StrConv(LCase((Trim(Left(strPair, k - 1)))), vbProperCase)
0075 j = InStr(k + 1, strPair, ",")
0076 strName2 = StrConv(Trim(Mid(strPair, k + 1, j - k - 1)), vbProperCase)
0077 'Need to fix Vas Nunes ...
0078 k = InStr(strName1, " ")
0079 If k = 0 Then
0080 k = InStr(strName2, " ")
0081 strName1 = strName1 & Mid(strName2, k, 200)
0082 End If
0083 'Sort the names
0084 If strName1 > strName2 Then
0085 strTemp = strName1
0086 strName1 = strName2
0087 strName2 = strTemp
0088 End If
0089 'Pair 2
0090 strPair2 = Trim(Mid(strPair, j + 1, 200))
0091 k = InStr(strPair2, ",")
0092 strName3 = StrConv(LCase((Trim(Left(strPair2, k - 1)))), vbProperCase)
0093 strName4 = StrConv(Trim(Mid(strPair2, k + 1, 200)), vbProperCase)
0094 'Need to fix Vas Nunes ...
0095 j = InStr(strName3, " ")
0096 If j = 0 Then
0097 k = InStr(strName4, " ")
0098 strName3 = strName3 & Mid(strName4, k, 200)
0099 End If
0100 'Sort the names
0101 If strName3 > strName4 Then
0102 strTemp = strName3
0103 strName3 = strName4
0104 strName4 = strTemp
0105 End If
0106 i = InStr(i + 1, strLine, "<TD")
0107 i = InStr(i + 4, strLine, ">")
0108 j = InStr(i, strLine, "</TD>")
0109 strScore = Trim(Mid(strLine, i + 1, j - i - 1))
0110 i = iRowEnd - 15
0111 i = InStr(i + 1, strLine, ">")
0112 j = InStr(i + 1, strLine, "</TD>")
0113 strMpts = Trim(Mid(strLine, i + 1, j - i - 1))
0114 strTops = 0
0115 strPercent = 0
0116 strSSlams = ""
0117 strGSlams = ""
0118 'Add Database Records
0119 '... Player 1
0120 rst.AddNew
0121 rst.Fields(0) = Club
0122 rst.Fields(1) = CDate(strDateTemp)
0123 rst.Fields(2) = Val(strPairNo)
0124 rst.Fields(3) = Orientation
0125 rst.Fields(4) = strName1
0126 rst.Fields(5) = strName2
0127 rst.Fields(6) = strName1 & " & " & strName2
0128 rst.Fields(7) = Replace(strPosition, "=", "")
0129 rst.Fields(8) = strScore
0130 rst.Fields(9) = strTops
0131 rst.Fields(10) = strPercent
0132 rst.Fields(11) = Val(strMpts)
0133 rst.Fields(12) = Val(strSSlams)
0134 rst.Fields(13) = Val(strGSlams)
0135 rst.Fields(14) = Now()
0136 rst.Update
0137 '... Player 2
0138 rst.AddNew
0139 rst.Fields(0) = Club
0140 rst.Fields(1) = CDate(strDateTemp)
0141 rst.Fields(2) = Val(strPairNo)
0142 rst.Fields(3) = Orientation
0143 rst.Fields(4) = strName2
0144 rst.Fields(5) = strName1
0145 rst.Fields(6) = strName1 & " & " & strName2
0146 rst.Fields(7) = Replace(strPosition, "=", "")
0147 rst.Fields(8) = strScore
0148 rst.Fields(9) = strTops
0149 rst.Fields(10) = strPercent
0150 rst.Fields(11) = Val(strMpts)
0151 rst.Fields(12) = Val(strSSlams)
0152 rst.Fields(13) = Val(strGSlams)
0153 rst.Fields(14) = Now()
0154 rst.Update
0155 '... Player 3
0156 rst.AddNew
0157 rst.Fields(0) = Club
0158 rst.Fields(1) = CDate(strDateTemp)
0159 rst.Fields(2) = Val(strPairNo)
0160 rst.Fields(3) = Orientation
0161 rst.Fields(4) = strName3
0162 rst.Fields(5) = strName4
0163 rst.Fields(6) = strName3 & " & " & strName4
0164 rst.Fields(7) = Replace(strPosition, "=", "")
0165 rst.Fields(8) = strScore
0166 rst.Fields(9) = strTops
0167 rst.Fields(10) = strPercent
0168 rst.Fields(11) = Val(strMpts)
0169 rst.Fields(12) = Val(strSSlams)
0170 rst.Fields(13) = Val(strGSlams)
0171 rst.Fields(14) = Now()
0172 rst.Update
0173 '... Player 4
0174 rst.AddNew
0175 rst.Fields(0) = Club
0176 rst.Fields(1) = CDate(strDateTemp)
0177 rst.Fields(2) = Val(strPairNo)
0178 rst.Fields(3) = Orientation
0179 rst.Fields(4) = strName4
0180 rst.Fields(5) = strName3
0181 rst.Fields(6) = strName3 & " & " & strName4
0182 rst.Fields(7) = Replace(strPosition, "=", "")
0183 rst.Fields(8) = strScore
0184 rst.Fields(9) = strTops
0185 rst.Fields(10) = strPercent
0186 rst.Fields(11) = Val(strMpts)
0187 rst.Fields(12) = Val(strSSlams)
0188 rst.Fields(13) = Val(strGSlams)
0189 rst.Fields(14) = Now()
0190 rst.Update
0191 iRowStart = InStr(iRowEnd, strLine, "<TR")
0192 If iRowStart = 0 Then
0193 i = iTableEnd + 1
0194 Else
0195 i = iRowStart
0196 End If
0197 Loop
0198 If Orientation = "NS" Then
0199 Orientation = "EW"
0200 strContinue = "Yes"
0201 End If
0202Loop
0203End Sub

Procedures Calling This Procedure (Parse_WebPage_JeffSmith_Teams) Tables / Queries / Fragments Directly Used By This Procedure (Parse_WebPage_JeffSmith_Teams) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



Source Code of: Web_Page_Control_Club_70s
Procedure Type: Public Function
Module: ScorebridgeConvertion
Lines of Code: 123
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Web_Page_Control_Club_70s(Club, prClub, CurrentYear, LastYear, FirstYear, MinSessions, MidYearQualSessions, QualSessions, Ladder_End_Month, maxQualifying, strHeader_Ladder, Ladder_Lowest_Percent, Ladder_Maximum_Length, Substitute_Directory)
0002Dim strOutputFolder As String
0003Dim strOutputFile As String
0004Dim strLine As String
0005Dim rsTableControl1 As Recordset
0006Dim rsTableControl2 As Recordset
0007Dim fsoTextFile2 As FileSystemObject
0008Dim tsTextFile As TextStream
0009Dim i As Integer
0010Dim j As Integer
0011Dim k As Integer
0012Dim z As Integer
0013Dim FileName As String
0014Dim strYear As String
0015Dim strMonth As String
0016Dim Session As String
0017Dim strQuery As String
0018Dim Average As String
0019Dim Average_Saved As String
0020Dim strPlace As String
0021Dim strQualified As String
0022Dim strMidYear As String
0023'Dim FirstYear As Integer 'This is the first year (ascending) for which to produce ladders
0024'Dim LastYear As Integer 'This is the last year (descending) for which to show results archive
0025Dim strBC As String
0026Dim strExtension As String
0027Dim strDate As String
0028Dim strField As String
0029Dim strPlayer As String
0030Dim strPlayer_Saved As String
0031Dim iSessions As Integer
0032Dim strRowspan As String
0033Dim MinSessions_Select As Integer
0034Dim QualSessions_Select As Integer
0035Dim strEnough As String
0036Dim strPre As String
0037Dim strPost As String
0038j = CurrentYear
0039strExtension = ".htm"
0040strOutputFolder = "C:\Theo's Files\Websites\Theo's Website\Bridge\" & Substitute_Directory & "\"
0041Set fsoTextFile2 = New FileSystemObject
0042FileName = Club & "_70s"
0043FileName = FileName & ".htm"
0044strOutputFile = strOutputFolder & FileName
0045Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFile, True)
0046tsTextFile.WriteLine strHeader_Ladder
0047strLine = "<p align=""center""><b><u>70s Club</u></b></p>"
0048tsTextFile.WriteLine strLine
0049strLine = "<p align=""center"">The table below shows - in descending date order - those who have scored 70% or more. </p>"
0050tsTextFile.WriteLine strLine
0051'Create the Player prelist table
0052 strQuery = "DELETE Club_Ladder_Prelist.* FROM Club_Ladder_Prelist;"
0053DoCmd.RunSQL (strQuery)
0054'This has to be Summation query because of multiple joins of full names with a middle initial. Eg. David F Clark appears as F Clark (David) and Clark (David F).
0055 strQuery = "INSERT INTO Club_Ladder_Prelist ( Club, [Year], Session_Date, Player, Percentage_Score, Partner ) SELECT Joint_Project_Results.Club, IIf(Month([Session_Date])>" & Ladder_End_Month & ",Year([Session_Date])+1,Year([Session_Date])) AS [Year], Joint_Project_Results.Session_Date, IIf([Alternate_Full_Name] & """"<>"""",[Alternate_Full_Name],[Full_Name]) AS Player, Joint_Project_Results.Percentage_Score, Joint_Project_Results.Partner FROM Joint_Project_Results INNER JOIN Joint_Project_Members ON Joint_Project_Results.Player = Joint_Project_Members.Full_Name GROUP BY Joint_Project_Results.Club, IIf(Month([Session_Date])>" & Ladder_End_Month & ",Year([Session_Date])+1,Year([Session_Date])), Joint_Project_Results.Session_Date, IIf([Alternate_Full_Name] & """"<>"""",[Alternate_Full_Name],[Full_Name]), Joint_Project_Results.Percentage_Score, Joint_Project_Results.Partner "
0056 strQuery = strQuery & "HAVING (((Joint_Project_Results.Club)=""" & Club & """));"
0057DoCmd.RunSQL (strQuery)
0058'Update the partner name if in error
0059 strQuery = "UPDATE Club_Ladder_Prelist INNER JOIN Joint_Project_Members ON Club_Ladder_Prelist.Partner = Joint_Project_Members.Full_Name SET Club_Ladder_Prelist.Partner = IIf([Alternate_Full_Name] & """"="""",[Full_Name],[Alternate_Full_Name]);"
0060DoCmd.RunSQL (strQuery)
0061'Delete the secretive types
0062 strQuery = "DELETE Club_Ladder_Prelist.* FROM Club_Exclusions INNER JOIN Club_Ladder_Prelist ON (Club_Exclusions.Player = Club_Ladder_Prelist.Player) AND (Club_Exclusions.Club = Club_Ladder_Prelist.Club);"
0063DoCmd.RunSQL (strQuery)
0064' ... and if the partner
0065 strQuery = "DELETE Club_Ladder_Prelist.* FROM Club_Exclusions INNER JOIN Club_Ladder_Prelist ON (Club_Exclusions.Player = Club_Ladder_Prelist.Partner) AND (Club_Exclusions.Club = Club_Ladder_Prelist.Club);"
0066DoCmd.RunSQL (strQuery)
0067'Adjust re dropped sessions in current year - ie. Christmas Party
0068 strQuery = "DELETE Club_Ladder_Prelist.* FROM Club_Ladder_Prelist INNER JOIN Club_Dropped_Sessions ON (Club_Ladder_Prelist.Session_Date = Club_Dropped_Sessions.SessionDate) AND (Club_Ladder_Prelist.Club = Club_Dropped_Sessions.Club);"
0069DoCmd.RunSQL (strQuery)
0070'Delete <70%s
0071 strQuery = "DELETE Club_Ladder_Prelist.*, Club_Ladder_Prelist.Percentage_Score FROM Club_Ladder_Prelist WHERE (((Club_Ladder_Prelist.Percentage_Score)<70));"
0072DoCmd.RunSQL (strQuery)
0073 strQuery = "SELECT Club_Ladder_Prelist.Session_Date, Club_Ladder_Prelist.Player, Club_Ladder_Prelist.Partner, Club_Ladder_Prelist.Percentage_Score FROM Club_Ladder_Prelist ORDER BY Club_Ladder_Prelist.Session_Date DESC , Club_Ladder_Prelist.Percentage_Score DESC , Club_Ladder_Prelist.Player;"
0074Set rsTableControl1 = CurrentDb.OpenRecordset(strQuery)
0075If Not rsTableControl1.EOF Then
0076 rsTableControl1.MoveFirst
0077 strLine = "<CENTER><table border=""1"" cellpadding=""1"" cellspacing=""0"" style=""width: 700px;""><TBODY>"
0078 tsTextFile.WriteLine strLine
0079 rsTableControl1.MoveFirst
0080End If
0081strLine = "<TR>"
0082tsTextFile.WriteLine strLine
0083strLine = "<TH WIDTH=""20%"" ALIGN=""center"" FONT Size = 2 FACE=""Arial"">Date</TH>"
0084tsTextFile.WriteLine strLine
0085strLine = "<TH WIDTH=""50%"" ALIGN=""Left"" FONT Size = 2 FACE=""Arial"">Partnership</TH>"
0086tsTextFile.WriteLine strLine
0087strLine = "<TH WIDTH=""10%"" ALIGN=""Right"" FONT Size = 2 FACE=""Arial"">%age</TH>"
0088tsTextFile.WriteLine strLine
0089strLine = "<TH WIDTH=""20%"" ALIGN=""Center"" FONT Size = 2 FACE=""Arial"">Results Link</TH>"
0090tsTextFile.WriteLine strLine
0091strLine = "</TR>"
0092tsTextFile.WriteLine strLine
0093Do While Not rsTableControl1.EOF
0094 strLine = "<TR>"
0095 tsTextFile.WriteLine strLine
0096 strLine = "<TD" & strRowspan & " WIDTH=""20%"" ALIGN=""center"" FONT Size = 2 FACE=""Arial"">" & rsTableControl1.Fields(0) & " </TD>"
0097 tsTextFile.WriteLine strLine
0098 strLine = "<TD" & strRowspan & " WIDTH=""50%"" ALIGN=""Left"" FONT Size = 2 FACE=""Arial"">" & rsTableControl1.Fields(1) & " & " & rsTableControl1.Fields(2) & " </TD>"
0099 tsTextFile.WriteLine strLine
0100 strLine = "<TD" & strRowspan & " WIDTH=""10%"" ALIGN=""Left"" FONT Size = 2 FACE=""Arial"">" & rsTableControl1.Fields(3) & " </TD>"
0101 tsTextFile.WriteLine strLine
0102 Session = rsTableControl1.Fields(0)
0103 If Year(Session) < FirstYear Then
0104 Session = "&nbsp;"
0105 Else
0106 Session = SessionLink(Session, strExtension, Club, "", "Session Link", "")
0107 End If
0108 strLine = "<TD" & strRowspan & " WIDTH=""20%"" ALIGN=""center"" FONT Size = 2 FACE=""Arial"">" & Session & " </TD>"
0109 tsTextFile.WriteLine strLine
0110 strLine = "</TR>"
0111 tsTextFile.WriteLine strLine
0112 rsTableControl1.MoveNext
0113 'Skip the "reverse partnership" record ...
0114 rsTableControl1.MoveNext
0115Loop
0116strLine = "</TR></TBODY></TABLE>"
0117tsTextFile.WriteLine strLine
0118strLine = "<p>Output: " & Now() & "</p><p>If you encounter problems, contact <A HREF=""mailto:theo@theotodman.com"">theo@theotodman.com</A></p></body></html>"
0119tsTextFile.WriteLine strLine
0120Set tsTextFile = Nothing
0121Set fsoTextFile2 = Nothing
0122 OK = CopyToTransfer(strOutputFolder, FileName)
0123End Function

Procedures Calling This Procedure (Web_Page_Control_Club_70s) Procedures Called By This Procedure (Web_Page_Control_Club_70s) Tables / Queries / Fragments Directly Used By This Procedure (Web_Page_Control_Club_70s) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page



© Theo Todman, June 2007 - July 2020 Please address any comments on this page to theo@theotodman.com. File output:
Website Maintenance Dashboard
Return to Top of this Page Return to Theo Todman's Bridge Page Return to Theo Todman's Home Page