THEO TODMAN’S WEBSITE CODE PAGES


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

Table of Code Documentation Location 23 (7 items)

CreateDocumentationJumpTablesDebugPrintFind_CountParse_Code_To_Wepage
Archive_NotesCreateDocumentationWebPagesCreateQueryFragmentsWebpages.

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

Go to top of page



Source Code of: Archive_Notes
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 41
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Archive_Notes()
0002'This sub copies to the Notes Archive any non-Temp Note that has either changed its Text or its Privacy status
0003'As this selects all such notes, it is essential that this Sub is only invoked if a "changed Notes only" Notes-Output run is performed.
0004Dim strControlQuery As String
0005Dim rsTableToRead As Recordset
0006Dim rsTableControl As Recordset
0007 DoCmd.OpenQuery ("Notes_Archive_Temp_Zap")
0008 strControlQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Item_Text, Notes_Archive_Latest.Item_Text, Notes.[Jump_Table?], Notes.Note_Group, Notes.Master_Note, Notes.Last_Changed, Notes.[Private?], Notes.Status, Notes.[Title?], Notes.[Respondent?], " & Last_Changed_Timestamp & " AS [Time], Notes_Archive_Latest.[Private?], Notes.Frozen_Timestamp, Notes.Note_Quality FROM Notes LEFT JOIN Notes_Archive_Latest ON Notes.ID = Notes_Archive_Latest.ID ORDER BY Notes.ID;"
0009Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0010rsTableToRead.MoveFirst
0011 Set rsTableControl = CurrentDb.OpenRecordset("SELECT Notes_Archive_Temp.* FROM Notes_Archive_Temp;")
0012Do While Not rsTableToRead.EOF
0013 If rsTableToRead.Fields(9) & "" <> "Temp" Then '(don't archive Temp Notes ... wait until they are no longer Temp)
0014 'Check if the text or Privacy Status differs between the current Note and the latest Archived Note
0015 If (rsTableToRead.Fields(2) <> rsTableToRead.Fields(3) & "") Or (rsTableToRead.Fields(8) <> rsTableToRead.Fields(13)) Then
0016 rsTableControl.AddNew
0017 rsTableControl.Fields(0) = rsTableToRead.Fields(0) 'ID
0018 rsTableControl.Fields(1) = rsTableToRead.Fields(1) 'Title
0019 rsTableControl.Fields(2) = rsTableToRead.Fields(2) 'Text
0020 rsTableControl.Fields(3) = rsTableToRead.Fields(4) 'Jump Table?
0021 rsTableControl.Fields(4) = rsTableToRead.Fields(5) 'Note Group
0022 rsTableControl.Fields(5) = rsTableToRead.Fields(6) 'Master Note
0023 rsTableControl.Fields(6) = rsTableToRead.Fields(7) 'Last Changed
0024 rsTableControl.Fields(7) = rsTableToRead.Fields(8) 'Private?
0025 rsTableControl.Fields(8) = rsTableToRead.Fields(9) 'Status - eg. Temp
0026 rsTableControl.Fields(9) = rsTableToRead.Fields(10) 'Title?
0027 rsTableControl.Fields(10) = rsTableToRead.Fields(11) 'Respondent?
0028 rsTableControl.Fields(11) = rsTableToRead.Fields(12) 'Last Changed Timestamp = Time
0029 rsTableControl.Fields(12) = rsTableToRead.Fields(14) 'Frozen Timestamp
0030 rsTableControl.Fields(13) = rsTableToRead.Fields(15) 'Note Quality
0031 rsTableControl.Update
0032 End If
0033 End If
0034 rsTableToRead.MoveNext
0035Loop
0036 DoCmd.OpenQuery ("Notes_Archive_GEN")
0037 DoCmd.OpenQuery ("Notes_LastChanged_Update")
0038 OK = Convert_Webrefs("Note_Archive", "Full")
0039Set rsTableToRead = Nothing
0040Set rsTableControl = Nothing
0041End Sub

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


Source Code of: CreateDocumentationJumpTables
Procedure Type: Public Function
Module: Documentation
Lines of Code: 125
Go To End of This Procedure

Line-No. / Ref.Code Line
0001 Public Function CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Optional Code_Location)
0002Dim rsTableToRead As Recordset
0003Dim rsTableControl As Recordset
0004Dim strControlQuery As String
0005Dim strLine As String
0006Dim i As Long
0007Dim strText As String
0008Dim strSearch As String
0009Dim strReplace As String
0010Dim strColPercentage As String
0011'Read the data
0012Select Case Procedure_Type
0013 Case "Table"
0014 strDataQuery = "SELECT Table_Definitions.Table_Name FROM Table_Definitions ORDER BY Table_Name;"
0015 Case "Query"
0016 If Code_Location >= 9999 Then
0017 strDataQuery = "SELECT Query_Definitions.Query_Name, Query_Definitions.Query_Type FROM Query_Definitions LEFT JOIN Unused_Queries ON Query_Definitions.Query_Name = Unused_Queries.Query_Name WHERE (((Unused_Queries.Query_Name) Is Null)) ORDER BY Query_Definitions.Query_Name;"
0018 Else
0019 strDataQuery = "SELECT Query_Definitions.Query_Name, Query_Definitions.Query_Type FROM Query_Definitions WHERE Query_Definitions.Query_Type = " & Code_Location & " ORDER BY Query_Name;"
0020 End If
0021 Case "QueryUnused"
0022 strDataQuery = "SELECT Unused_Queries.Query_Name, Unused_Queries.Query_Type FROM Unused_Queries ORDER BY Unused_Queries.Query_Name;"
0023 Case "Fragment"
0024 strDataQuery = "SELECT Query_Name_Fragments.Query_Name_Fragment FROM Query_Name_Fragments GROUP BY Query_Name_Fragments.Query_Name_Fragment ORDER BY Query_Name_Fragments.Query_Name_Fragment;"
0025 Case "Private Sub", "Public Sub", "Private Function", "Public Function", "Location"
0026 If IsMissing(Code_Location) Then
0027 strDataQuery = "SELECT Code_Table.Procedure_Type, Code_Table.Procedure_Name, Code_Table.Code_Location, Code_Table.ID FROM Code_Table WHERE (((Code_Table.Procedure_Type) = """ & Procedure_Type & """)) ORDER BY Code_Table.Procedure_Type, Code_Table.Procedure_Name;"
0028 Else
0029 strDataQuery = "SELECT Code_Table.Procedure_Type, Code_Table.Procedure_Name, Code_Table.Code_Location, Code_Table.ID FROM Code_Table WHERE (((Code_Table.Code_Location) = " & Code_Location & ")) ORDER BY Code_Table.Procedure_Type, Code_Table.Procedure_Name;"
0030 End If
0031 Case "Modules"
0032 If IsMissing(Code_Location) Then
0033 strDataQuery = "SELECT Code_Table.Module FROM Code_Table GROUP BY Code_Table.Module ORDER BY Code_Table.Module;"
0034 Else
0035 strDataQuery = "SELECT Code_Table.Procedure_Name, Code_Location.Code_Location FROM Code_Table INNER JOIN Code_Location ON Code_Table.Procedure_Name = Code_Location.Procedure_Name WHERE (((Code_Table.Module) = """ & Code_Location & """)) ORDER BY Code_Table.Procedure_Name;"
0036 End If
0037 Case Else
0038 MsgBox "Invalid Procedure Type (" & Procedure_Type & ")"
0039 strDataQuery = ""
0040End Select
0041Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery)
0042strColPercentage = Round(100 / iTableColumns, 1)
0043'Title
0044rsTableToRead.MoveLast
0045strLine = "<A Name = """ & Replace(Heading, " ", "") & """></A><h2 class = ""Left"">Table of " & Heading & " (" & rsTableToRead.RecordCount & " items)</h2>"
0046tsTextFile.WriteLine strLine
0047'Table Header
0048 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""TableHeader"")) ORDER BY Website_Control.Line;"
0049Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0050rsTableControl.MoveFirst
0051Do While Not rsTableControl.EOF
0052 strLine = rsTableControl.Fields(0) & ""
0053 tsTextFile.WriteLine strLine
0054 rsTableControl.MoveNext
0055Loop
0056'Accummulate the table-row pro-forma
0057 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""TableRows"")) ORDER BY Website_Control.Line;"
0058Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0059rsTableControl.MoveFirst
0060strText = ""
0061Do While Not rsTableControl.EOF
0062 If InStr(rsTableControl.Fields(0) & "", "**") > 0 Then
0063 For i = 1 To iTableColumns
0064 strText = strText & Replace(rsTableControl.Fields(0) & "", "**Percent**", strColPercentage)
0065 strText = Replace(strText, "**Column**", "**Column" & i & "**")
0066 Next i
0067 Else
0068 strText = strText & rsTableControl.Fields(0) & ""
0069 End If
0070 rsTableControl.MoveNext
0071Loop
0072i = 1
0073strLine = strText
0074If Not rsTableToRead.EOF Then
0075 rsTableToRead.MoveFirst
0076 Do Until rsTableToRead.EOF
0077 Select Case Procedure_Type
0078 Case "Table"
0079 strReplace = "<A HREF=""" & SubSystem & "Documentation_Code_Tables.htm#" & rsTableToRead.Fields(0) & """>" & rsTableToRead.Fields(0) & "</A>"
0080 Case "Query", "QueryUnused"
0081 strReplace = "<A HREF=""" & SubSystem & "Documentation_Code_Queries_" & rsTableToRead.Fields(1) & ".htm#" & rsTableToRead.Fields(0) & """>" & rsTableToRead.Fields(0) & "</A>"
0082 Case "Fragment"
0083 strReplace = "<A HREF=""" & SubSystem & "Documentation_Code_Fragments.htm#" & rsTableToRead.Fields(0) & """>" & rsTableToRead.Fields(0) & "</A>"
0084 Case "Private Sub", "Public Sub", "Private Function", "Public Function", "Location"
0085 strReplace = "<A HREF=""" & SubSystem & "Documentation_Code_" & rsTableToRead.Fields(2) & ".htm#" & rsTableToRead.Fields(1) & """>" & rsTableToRead.Fields(1) & "</A>"
0086 Case "Modules"
0087 If IsMissing(Code_Location) Then
0088 strReplace = "<A HREF=""" & SubSystem & "Documentation_Code_Modules.htm#" & "Module:" & Replace(rsTableToRead.Fields(0), " ", "") & """>" & rsTableToRead.Fields(0) & "</A>"
0089 Else
0090 strReplace = "<A HREF=""" & SubSystem & "Documentation_Code_" & rsTableToRead.Fields(1) & ".htm#" & Replace(rsTableToRead.Fields(0), " ", "") & """>" & rsTableToRead.Fields(0) & "</A>"
0091 End If
0092 Case Else
0093 MsgBox "Invalid Procedure Type (" & Procedure_Type & ")"
0094 End Select
0095 strSearch = "**Column" & i & "**"
0096 strLine = Replace(strLine, strSearch, strReplace)
0097 'Next Record
0098 rsTableToRead.MoveNext
0099 i = i + 1
0100 If i > iTableColumns Then
0101 tsTextFile.WriteLine strLine
0102 i = 1
0103 strLine = strText
0104 End If
0105 Loop
0106 If i <> 1 Then
0107 For i = i To iTableColumns
0108 strSearch = "**Column" & i & "**"
0109 strLine = Replace(strLine, strSearch, ".")
0110 Next i
0111 tsTextFile.WriteLine strLine
0112 End If
0113End If
0114'Table Footer
0115 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""TableFooter"")) ORDER BY Website_Control.Line;"
0116Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0117rsTableControl.MoveFirst
0118Do While Not rsTableControl.EOF
0119 strLine = rsTableControl.Fields(0) & ""
0120 tsTextFile.WriteLine strLine
0121 rsTableControl.MoveNext
0122Loop
0123strLine = "<A HREF = ""#Top"">Go to top of page</A><br><br>"
0124tsTextFile.WriteLine strLine
0125End Function

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


Source Code of: CreateDocumentationWebPages
Procedure Type: Public Sub
Module: Documentation
Lines of Code: 117
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub CreateDocumentationWebPages()
0002'This is a new module to generate the application code documentation pages
0003'It was based on Sub CreateConcatenatedNoteGroupWebPages
0004Dim rsTableControl As Recordset
0005Dim strControlQuery As String
0006Dim strLine As String
0007Dim iTableColumns As Integer
0008Dim strFileSuffix As String
0009Dim strFileBody As String
0010Dim Procedure_Type As String
0011Dim Heading As String
0012Dim rsTableToRead As Recordset
0013Dim rsTableToRead2 As Recordset
0014Dim rsProcedure_Location As Recordset
0015Dim Procedure_Location As Integer
0016Dim Time_Stamp As String
0017strControlTable = "DocumentationControl"
0018strOutputFileShort = SubSystem & "DocumentationControl"
0019strOutputFolder = TheoWebsiteRoot & "\Documentation\"
0020strOutputFile = ""
0021strFileBody = ""
0022strFileSuffix = strOutputFileShort
0023Set fsoTextFile2 = New FileSystemObject
0024strFolder = strOutputFolder
0025'Create File
0026Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFolder & strOutputFileShort & ".htm", True, True)
0027'Page Header
0028 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;"
0029Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0030rsTableControl.MoveFirst
0031Do While Not rsTableControl.EOF
0032 strLine = rsTableControl.Fields(0) & ""
0033 tsTextFile.WriteLine strLine
0034 rsTableControl.MoveNext
0035Loop
0036strLine = "<A Name = ""Top""></A>"
0037tsTextFile.WriteLine strLine
0038'Create list of Tables on this page
0039strLine = "<OL>"
0040tsTextFile.WriteLine strLine
0041strLine = "<LI>Code by Category<UL><LI><A HREF = ""#PrivateSubroutines"">Private Subroutines</A></li>"
0042tsTextFile.WriteLine strLine
0043strLine = "<LI><A HREF = ""#PublicSubroutines"">Public Subroutines</A></li>"
0044tsTextFile.WriteLine strLine
0045strLine = "<LI><A HREF = ""#PublicFunctions"">Public Functions</A></li></UL>"
0046tsTextFile.WriteLine strLine
0047strLine = "<LI><A HREF = ""#Modules"">Code by Module</A></li>"
0048tsTextFile.WriteLine strLine
0049strLine = "<LI><A HREF = ""#Tables"">Tables</A></li>"
0050tsTextFile.WriteLine strLine
0051strLine = "<LI>Queries<UL><LI><A HREF = ""#Queries"">Queries</A></li>"
0052tsTextFile.WriteLine strLine
0053strLine = "<LI><A HREF = ""#QueryFragments"">Query Fragments</A></li>"
0054tsTextFile.WriteLine strLine
0055strLine = "<LI><A HREF = ""#Queries(Probably)UnusedbytheGenerator"">Queries (Probably) Unused by the Generator</A></li></UL></OL>"
0056tsTextFile.WriteLine strLine
0057iTableColumns = 4
0058Procedure_Type = "Private Sub"
0059Heading = "Private Subroutines"
0060 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns)
0061iTableColumns = 3
0062Procedure_Type = "Public Sub"
0063Heading = "Public Subroutines"
0064 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns)
0065iTableColumns = 5
0066Procedure_Type = "Public Function"
0067Heading = "Public Functions"
0068 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns)
0069iTableColumns = 5
0070Procedure_Type = "Modules"
0071Heading = "Modules"
0072 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns)
0073iTableColumns = 4
0074Procedure_Type = "Table"
0075Heading = "Tables"
0076Procedure_Location = 9999
0077 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location)
0078iTableColumns = 4
0079Procedure_Type = "Query"
0080Heading = "Queries"
0081Procedure_Location = 9999
0082 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location)
0083iTableColumns = 6
0084Procedure_Type = "Fragment"
0085Heading = "Query Fragments"
0086Procedure_Location = 9999
0087 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location)
0088iTableColumns = 4
0089Procedure_Type = "QueryUnused"
0090Heading = "Queries (Probably) Unused by the Generator"
0091Procedure_Location = 9999
0092 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location)
0093'Page Footer
0094 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;"
0095Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0096rsTableControl.MoveFirst
0097Do While Not rsTableControl.EOF
0098 Time_Stamp = rsTableControl.Fields(0) & ""
0099 OK = Replace_Timestamp(Time_Stamp)
0100 tsTextFile.WriteLine Time_Stamp
0101 rsTableControl.MoveNext
0102Loop
0103 OK = CopyToTransfer(strFolder & "\", strFileSuffix & ".htm")
0104Set tsTextFile = Nothing
0105'Create the Code, Query, Query Fragment & Table Web-pages
0106 CreateCodeWebpages
0107 CreateQueryWebpages
0108 CreateTableWebpages
0109 CreateQueryFragmentsWebpages
0110 CreateModulesWebpage
0111'Update the Note that documents the MainForm
0112 Forms_Documenter
0113Set tsTextFile = Nothing
0114Set rsTableToRead = Nothing
0115Set rsTableToRead2 = Nothing
0116Set rsProcedure_Location = Nothing
0117End Sub

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


Source Code of: CreateQueryFragmentsWebpages
Procedure Type: Public Sub
Module: Documentation
Lines of Code: 138
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub CreateQueryFragmentsWebpages()
0002Dim rsTableControl As Recordset
0003Dim strControlQuery As String
0004Dim strLine As String
0005Dim iTableColumns As Integer
0006Dim strFileSuffix As String
0007Dim Procedure_Type As String
0008Dim Heading As String
0009Dim rsTableToRead As Recordset
0010Dim rsTableToRead2 As Recordset
0011Dim rsProcedure_Location As Recordset
0012Dim Procedure_Location As Integer
0013Dim This_Location As Integer
0014Dim This_Object As String
0015Dim This_Object_Count As String
0016Dim This_Line As Integer
0017Dim Last_Location As Integer
0018Dim Last_Object As String
0019Dim Last_Line As Integer
0020'Create the Documentation_Code_Fragments File
0021'Read the data
0022 strDataQuery = "SELECT Query_Name_Fragments.* FROM Query_Name_Fragments ORDER BY Query_Name_Fragments.Query_Name_Fragment;"
0023Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery)
0024rsTableToRead.MoveFirst
0025'Create File
0026strOutputFileShort = SubSystem & "Documentation_Code_Fragments"
0027Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFolder & strOutputFileShort & ".htm", True, True)
0028'Create Page Header
0029 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Header"")) ORDER BY Website_Control.Line;"
0030Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0031rsTableControl.MoveFirst
0032Do While Not rsTableControl.EOF
0033 strLine = rsTableControl.Fields(0) & ""
0034 tsTextFile.WriteLine strLine
0035 rsTableControl.MoveNext
0036Loop
0037'Create Jump Table
0038iTableColumns = 6
0039Procedure_Type = "Fragment"
0040Heading = "Query Fragment Documentation"
0041Procedure_Location = 0
0042 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Procedure_Location)
0043Do While Not rsTableToRead.EOF
0044 Heading = rsTableToRead.Fields(1).Value
0045 'Create Heading
0046 strLine = "<A Name =""" & Heading & """></A>" & "<B>" & rsTableToRead.Fields(1).Name & ": " & Heading & "</B><BR><BR>"
0047 tsTextFile.WriteLine strLine
0048 'Create Links to Associated Queries
0049 strDataQuery = "SELECT Query_Name_Fragments.Query_Name_Fragment, Query_Name_Fragments.Query_Name, Query_Definitions.Query_Type, Query_Name_Fragments.Query_Name_Residue, Query_Definitions_1.Query_Type FROM (Query_Name_Fragments INNER JOIN Query_Definitions ON Query_Name_Fragments.Query_Name = Query_Definitions.Query_Name) LEFT JOIN Query_Definitions AS Query_Definitions_1 ON Query_Name_Fragments.Query_Name_Residue = Query_Definitions_1.Query_Name WHERE (((Query_Name_Fragments.Query_Name_Fragment) = """ & Heading & """)) ORDER BY Query_Name_Fragments.Query_Name;"
0050 Set rsTableToRead2 = CurrentDb.OpenRecordset(strDataQuery)
0051 rsTableToRead2.MoveFirst
0052 strLine = "<U><B>Queries Using this Query Fragment</U></B><UL>"
0053 tsTextFile.WriteLine strLine
0054 Do While Not rsTableToRead2.EOF
0055 strLine = "<LI><A HREF = """ & SubSystem & "Documentation_Code_Queries_" & rsTableToRead2.Fields(2).Value & ".htm#" & rsTableToRead2.Fields(1).Value & """>" & rsTableToRead2.Fields(1).Value & "</A>" & IIf(rsTableToRead2.Fields(4).Value & "" <> "", " (Residue-query is <A HREF = """ & SubSystem & "Documentation_Code_Queries_" & rsTableToRead2.Fields(4).Value & ".htm#" & rsTableToRead2.Fields(3).Value & """>" & rsTableToRead2.Fields(3).Value & "</A>)", "") & "</li>"
0056 tsTextFile.WriteLine strLine
0057 rsTableToRead2.MoveNext
0058 Loop
0059 strLine = "</UL>"
0060 tsTextFile.WriteLine strLine
0061 'Create Code Links In
0062 strDataQuery = "SELECT Query_Links_Table.*, Query_Definitions.Query_Type FROM Query_Links_Table LEFT JOIN Query_Definitions ON Query_Links_Table.Object_1 = Query_Definitions.Query_Name WHERE (((Query_Links_Table.Object_2) = """ & Heading & """) AND Query_Links_Table.Object_2_Type = ""F"" AND Query_Links_Table.Object_1_Type = ""C"") ORDER BY Query_Links_Table.Object_1_Type, Query_Links_Table.Object_1, Query_Links_Table.Code_Line;"
0063 Set rsTableToRead2 = CurrentDb.OpenRecordset(strDataQuery)
0064 If Not rsTableToRead2.EOF Then
0065 rsTableToRead2.MoveFirst
0066 strLine = "<U><B>Code Using this Query Fragment</U></B><UL>"
0067 tsTextFile.WriteLine strLine
0068 strLine = ""
0069 Last_Object = "zzzz"
0070 This_Object_Count = 0
0071 Do While Not rsTableToRead2.EOF
0072 This_Object = rsTableToRead2.Fields(0)
0073 'Find the Code_Location ...
0074 Set rsProcedure_Location = CurrentDb.OpenRecordset("Select Code_Location.Code_Location FROM Code_Location WHERE Code_Location.Procedure_Name = """ & This_Object & """;")
0075 rsProcedure_Location.MoveFirst
0076 This_Location = rsProcedure_Location.Fields(0)
0077 This_Line = rsTableToRead2.Fields(4)
0078 If Last_Object = This_Object Then
0079 If This_Object_Count = 1 Then
0080 strLine = "<LI>" & Last_Object & " (From Lines <A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>, "
0081 Else
0082 strLine = strLine & "<A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>, "
0083 End If
0084 This_Object_Count = This_Object_Count + 1
0085 Else
0086 If Last_Object <> "zzzz" Then
0087 If This_Object_Count = 1 Then
0088 strLine = "<LI>" & Last_Object & " (From Line <A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0089 Else
0090 strLine = strLine & "<A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0091 End If
0092 tsTextFile.WriteLine strLine
0093 End If
0094 This_Object_Count = 1
0095 End If
0096 rsTableToRead2.MoveNext
0097 Last_Location = This_Location
0098 Last_Object = This_Object
0099 Last_Line = This_Line
0100 Loop
0101 'Last line
0102 If Last_Object <> "zzzz" Then
0103 If This_Object_Count = 1 Then
0104 strLine = "<LI>" & Last_Object & " (From Line <A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0105 Else
0106 strLine = strLine & "<A HREF=""" & SubSystem & "Documentation_Code_" & Last_Location & ".htm#" & Last_Object & "_" & Last_Line & """>" & Last_Line & "</A>)</LI>"
0107 End If
0108 tsTextFile.WriteLine strLine
0109 End If
0110 strLine = "</UL>"
0111 tsTextFile.WriteLine strLine
0112 End If
0113 'Create link to top of page
0114 strLine = "<A HREF=""#Top"">Go To Top of This Page</A><br>"
0115 tsTextFile.WriteLine strLine
0116 'Create link to main code jump-table
0117 strLine = "<A HREF=""" & SubSystem & "DocumentationControl.htm"">Link to VBA Code Control Page</A><br>"
0118 tsTextFile.WriteLine strLine
0119 'Rule off ready for next procedure
0120 strLine = "<BR><HR>"
0121 tsTextFile.WriteLine strLine
0122 rsTableToRead.MoveNext
0123Loop
0124'Finish File
0125'Page Footer
0126 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;"
0127Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0128rsTableControl.MoveFirst
0129Do While Not rsTableControl.EOF
0130 strLine = rsTableControl.Fields(0)
0131 OK = Replace_Timestamp(strLine)
0132 tsTextFile.WriteLine strLine
0133 rsTableControl.MoveNext
0134Loop
0135'Copy to Transfer
0136strFileSuffix = strOutputFileShort
0137 OK = CopyToTransfer(strFolder, strFileSuffix & ".htm")
0138End Sub

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


Source Code of: DebugPrint
Procedure Type: Public Function
Module: Testing
Lines of Code: 6

Line-No. / Ref.Code Line
0001Public Function DebugPrint(Suppress_Debug_Printing, strString)
0002'Trivial little function, to save if statements, etc
0003If Suppress_Debug_Printing = False Then
0004 Debug.Print Now() & " - " & strString
0005End If
0006End Function

Procedures Calling This Procedure (DebugPrint) Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Find_Count
Procedure Type: Public Function
Module: New Code
Lines of Code: 22
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Find_Count(strString, Findit)
0002'Function to find the number of occurrences of one string in another
0003Dim iPos As Long
0004Dim iCount As Long
0005Dim iLen As Long
0006iPos = 1
0007iCount = 0
0008iLen = Len(strString)
0009Do While iPos > 0
0010 If iPos = 1 Then
0011 iPos = 0
0012 End If
0013 iPos = InStr(iPos + 1, strString, Findit)
0014 If iPos > 0 Then
0015 iCount = iCount + 1
0016 End If
0017 If iPos = iLen Then
0018 iPos = 0
0019 End If
0020Loop
0021Find_Count = iCount
0022End Function

Procedures Calling This Procedure (Find_Count) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


Source Code of: Parse_Code_To_Wepage
Procedure Type: Public Function
Module: Documentation
Lines of Code: 49
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Parse_Code_To_Wepage(Code)
0002Dim Code_Local As String
0003Dim i As Long
0004Dim j As Long
0005Dim k As Long
0006Dim String_Length As Long
0007Dim strLine As String
0008Dim RowStart As String
0009Dim RowMiddle As String
0010Dim RowEnd As String
0011i = 1
0012j = 1
0013RowStart = "<tr><td width=""10%"" class = ""CodeLeft"">"
0014RowMiddle = "</td><td width=""90%"" class = ""CodeLeft"">"
0015RowEnd = "</td></tr>"
0016Code_Local = Code
0017String_Length = Len(Code_Local)
0018strLine = "<p></p><TABLE class = ""Code"" WIDTH=1100>"
0019tsTextFile.WriteLine strLine
0020strLine = Replace(RowStart & "Line-No. / Ref." & RowMiddle & "Code Line" & RowEnd, "td", "th")
0021tsTextFile.WriteLine strLine
0022j = InStr(i, Code_Local, Chr$(10))
0023Do Until j = 0
0024 'Find line-end
0025 'Check line-start
0026 If Mid(Code_Local, i, 1) = "<" Then
0027 'Starts with an <A Name ></A><A HREF" ...></A>
0028 k = InStr(i, Code_Local, "/")
0029 k = InStr(k + 1, Code_Local, "/")
0030 k = k + 3
0031 strLine = Mid(Code_Local, i, k - i)
0032 Else
0033 strLine = Trim(Mid(Code_Local, i, 5))
0034 k = i + 5
0035 End If
0036 strLine = RowStart & strLine & RowMiddle
0037 If j > 0 Then
0038 strLine = strLine & "<xmp>" & Mid(Code_Local, k, j - k) & ""
0039 Else
0040 strLine = strLine & "<xmp>" & Mid(Code_Local, k, Len(Code_Local)) & ""
0041 End If
0042 strLine = strLine & RowEnd
0043 tsTextFile.WriteLine strLine
0044 i = j + 1
0045 j = InStr(i, Code_Local, Chr$(10))
0046Loop
0047strLine = "</TABLE><p></p>"
0048tsTextFile.WriteLine strLine
0049End Function

Procedures Calling This Procedure (Parse_Code_To_Wepage) Go To Start of This Procedure
Go To Top of This Page
Link to VBA Code Control Page


© Theo Todman, June 2007 - April 2026. 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 Philosophy Page Return to Theo Todman's Home Page