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 36 (9 items)

cmdAuto_Reference_Notes_ClickcmdWebLinks_ClickcmdWebsiteMaintenanceDashboard_ClickFunctor_01
Archive_Xtab_PageStartTimerTranslate_WebrefsWebpageGenBooksRecent
WebpageGenNoteBooksLinks...

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

Go to top of page




Source Code of: Archive_Xtab_Page
Procedure Type: Public Sub
Module: Documentation
Lines of Code: 136
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Archive_Xtab_Page(Optional Recent)
0002'Create web-page of (recent) Code changes
0003Dim strOutputFolder As String
0004Dim strOutputFile As String
0005Dim strLine As String
0006Dim strHeader As String
0007Dim rsTableControl2 As Recordset
0008Dim j As Integer
0009Dim FileName As String
0010Dim FileName_Root As String
0011Dim ifields As Integer
0012Dim iFieldWidth As Integer
0013Dim Field_Width As Integer
0014Dim x As String
0015Dim strRecent As String
0016Dim strRecent_Meaning As String
0017Dim strQuery As String
0018Dim strFile_Sub As String
0019Dim strTitle As String
0020strOutputFolder = "C:\Theo's Files\Websites\Theo's Website\Documentation\"
0021If SubSystem & "" = "" Then
0022 FileName_Root = "Code_Archive"
0023Else
0024 FileName_Root = SubSystem & "_Code_Archive"
0025End If
0026If IsMissing(Recent) Then
0027 strFile_Sub = ""
0028 strTitle = ""
0029 strRecent = ""
0030 strRecent_Meaning = ""
0031 strQuery = "Code_Archive_Xtab"
0032Else
0033 strFile_Sub = "_Recent"
0034 strTitle = "Recent "
0035 strRecent = "recent "
0036 strRecent_Meaning = " ""Recent"" is within the last 12 months."
0037 strQuery = "Code_Archive_Xtab_Recent"
0038End If
0039strTitle = "Theo Todman's " & strTitle & Trim(SubSystem & " Code Changes")
0040Set rsTableControl2 = CurrentDb.OpenRecordset(strQuery)
0041DoEvents
0042If Not rsTableControl2.EOF Then
0043 rsTableControl2.MoveLast
0044 ifields = rsTableControl2.Fields.Count - 1 'Ignore Code Location in field 0
0045 iFieldWidth = 1000 / ifields
0046 rsTableControl2.MoveFirst
0047End If
0048DoEvents
0049Set fsoTextFile2 = New FileSystemObject
0050FileName = FileName_Root & strFile_Sub & ".htm"
0051strOutputFile = strOutputFolder & FileName
0052Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFile, True, True)
0053'Headings
0054strLine = "<!DOCTYPE html><HTML lang=""en"">"
0055strLine = strLine & "<HEAD><meta charset=""utf-8""><TITLE>" & strTitle & "</TITLE><link href=""../TheosStyle.css"" rel=""stylesheet"" type=""text/css""><link rel=""shortcut icon"" href=""../TT_ICO.png"" /></HEAD><BODY><H1 align=""center""><B>" & strTitle & "</B></H1><CENTER>"
0056tsTextFile.WriteLine strLine
0057If IsMissing(Recent) Then
0058 strLine = "<h3>Full List</h3>"
0059Else
0060 strLine = "<h3>Recent List</h3>"
0061End If
0062strLine = strLine & "<p>This table lists all the recorded " & strRecent & "changes to my website generator, most recent first. The ""number"" is the length of the procedure in characters. A change is ""logged"" when the documenter is run. Currently the hyperlink is to the latest version of the code only." & strRecent_Meaning & "</p>"
0063tsTextFile.WriteLine strLine
0064If Not rsTableControl2.EOF Then
0065 strLine = "<TABLE class = ""Bridge"" WIDTH=1200>"
0066 tsTextFile.WriteLine strLine
0067 rsTableControl2.MoveFirst
0068 'Headings
0069 strLine = "<TR>"
0070 j = 1
0071 Do While j < ifields + 1
0072 If j = 1 Then
0073 Field_Width = 200
0074 Else
0075 Field_Width = iFieldWidth
0076 End If
0077 x = rsTableControl2.Fields(j).Name
0078 strLine = strLine & "<th width = " & Field_Width & ">" & x & "</th>"
0079 j = j + 1
0080 Loop
0081 strLine = strLine & "</TR>"
0082 tsTextFile.WriteLine strLine
0083 strHeader = strLine
0084 Do While Not rsTableControl2.EOF
0085 strLine = "<TR>"
0086 j = 1
0087 Do While j < ifields + 1
0088 If j = 1 Then
0089 Field_Width = 200
0090 Else
0091 Field_Width = iFieldWidth
0092 End If
0093 x = rsTableControl2.Fields(j) & ""
0094 If x = "" Then
0095 x = "&nbsp;"
0096 End If
0097 If j = 1 Then
0098 x = "<a href=""Documentation_Code_" & rsTableControl2.Fields(0) & ".htm#" & rsTableControl2.Fields(1) & """>" & x & "</a>"
0099 End If
0100 strLine = strLine & "<td width = " & Field_Width & ">" & x & "</td>"
0101 j = j + 1
0102 Loop
0103 strLine = strLine & "</TR>"
0104 tsTextFile.WriteLine strLine
0105 rsTableControl2.MoveNext
0106 Loop
0107 tsTextFile.WriteLine strHeader
0108 strLine = "</TABLE>"
0109 tsTextFile.WriteLine strLine
0110End If
0111'Page Footer
0112strLine = "<p>&nbsp;</p><TABLE Class = ""Bridge"" WIDTH=1000>"
0113tsTextFile.WriteLine strLine
0114strLine = "<TR>"
0115tsTextFile.WriteLine strLine
0116strLine = "<TH WIDTH=""30%"">&copy; Theo Todman; Apr. 2007 - " & MonthName(Month(Now())) & " " & Year(Now()) & "</TH>"
0117tsTextFile.WriteLine strLine
0118strLine = "<TH WIDTH=""40%"">Please address any comments on this page to <A HREF=""mailto:theo@theotodman.com"">theo@theotodman.com</A>.</TH>"
0119tsTextFile.WriteLine strLine
0120strLine = "<TH WIDTH=""30%""><A HREF=""../Notes/Notes_10/Notes_1010.htm"" TARGET = ""_top"">Website Maintenance Dashboard</A></TH>"
0121tsTextFile.WriteLine strLine
0122strLine = "</TR>"
0123tsTextFile.WriteLine strLine
0124strLine = "<TR>"
0125tsTextFile.WriteLine strLine
0126strLine = "<TH WIDTH=""30%""><A HREF=""../index.htm"" TARGET = ""_top"">Return to Theo Todman's Home Page</A></TH>"
0127tsTextFile.WriteLine strLine
0128strLine = "<TH WIDTH=""40%""><A HREF=""../Notes/Notes_11/Notes_1140.htm"" TARGET = ""_top"">Return to Theo Todman's Philosophy Page</A></TH>"
0129tsTextFile.WriteLine strLine
0130strLine = "<TH WIDTH=""30%"">Timestamp : <time datetime=""" & Year(Now()) & "-" & Right(Month(Now()) + 100, 2) & "-" & Right(Day(Now()) + 100, 2) & """ pubdate>" & Now() & "</time></TH>"
0131tsTextFile.WriteLine strLine
0132strLine = "</TR></TABLE></CENTER>"
0133tsTextFile.WriteLine strLine
0134 OK = CopyToTransfer(strOutputFolder, FileName)
0135Set tsTextFile = Nothing
0136End Sub

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



Source Code of: cmdAuto_Reference_Notes_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 24
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdAuto_Reference_Notes_Click()
0002Dim MsgBox_Response
0003Dim Start_Time As Date
0004If MsgBox("Do you want to update the Note_Alternates and / or Excluded_Cognates Tables?", vbYesNo) = vbYes Then
0005 DoCmd.Close acTable, "Note_Alternates"
0006 DoCmd.OpenTable ("Note_Alternates")
0007 DoCmd.Close acTable, "Excluded_Cognates"
0008 DoCmd.OpenTable ("Excluded_Cognates")
0009Else
0010 MsgBox_Response = MsgBox("Do you want to regenerate all the Notes_Link pages?", vbYesNoCancel + vbDefaultButton2)
0011 If MsgBox_Response = vbYes Then
0012 Debug.Print Now() & " - Entering Auto_Reference_Notes_Regen"
0013 Start_Time = Now()
0014 Auto_Reference_Notes_Regen ("Yes")
0015 Debug.Print Now() & " - Returned from Auto_Reference_Notes_Regen in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes."
0016 MsgBox ("Auto_Reference_Notes_Regen completed successfully in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0017 Else
0018 If MsgBox_Response = vbNo Then
0019 automatic_processing = "No"
0020 Auto_Reference_Notes
0021 End If
0022 End If
0023End If
0024End Sub

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



Source Code of: cmdWebLinks_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 67
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdWebLinks_Click()
0002Dim Start_Time As Date
0003Dim Webrefs_Option As String
0004Dim Option_Help As String
0005Dim rs As Recordset
0006Dim rsTableToRead As Recordset
0007Dim iManual_Check_Months As Integer
0008Dim Duration As Single
0009iManual_Check_Months = 3 'Parameter
0010 DoCmd.OpenQuery ("WebRef_Kernels_Updt")
0011 Set rs = CurrentDb.OpenRecordset("SELECT Max(Webrefs_Table.Date_Last_Checked) AS MaxOfDate_Last_Checked FROM Webrefs_Table WHERE (((Webrefs_Table.Issue)=""Manual Check OK""));")
0012If Not rs.EOF Then
0013 rs.MoveFirst
0014 If Now() - Nz(rs.Fields(0)) > iManual_Check_Months * 365 / 12 Then
0015 If MsgBox("It's time to check the manually-checked WebRefs! Do so now?", vbYesNo) = vbYes Then
0016 DoCmd.OpenQuery ("qryWebRefs_Check_Manual")
0017 MsgBox ("Blank the last-checked info in the query, run the recent-checker, and manually-check any that fail. ")
0018 End
0019 End If
0020 End If
0021End If
0022 Option_Help = "1. Update the Webrefs_Table Table"
0023 Option_Help = Option_Help & Chr$(10) & "2. Check The Webrefs_Table External Links"
0024Option_Help = Option_Help & Chr$(10) & "3. Regenerate the External Links Test Pages"
0025Option_Help = Option_Help & Chr$(10) & "4. Display Webrefs Errors"
0026Option_Help = Option_Help & Chr$(10) & "5. Translate WebRefs"
0027 Option_Help = Option_Help & Chr$(10) & "6. Re-create the WebRef_Maps Table"
0028Webrefs_Option = InputBox(Option_Help, "Enter an integer Webrefs Option", 1)
0029If Len(Webrefs_Option) = 0 Then
0030 End
0031End If
0032If Webrefs_Option < "1" Or Webrefs_Option > "6" Then
0033 MsgBox ("Choose an Option between 1 and 6")
0034 End
0035End If
0036Start_Time = Now()
0037Select Case Webrefs_Option
0038 Case 1
0039 DoCmd.OpenQuery ("qrySearch_Webrefs_Table")
0040 Case 2
0041 Webrefs_Update
0042 MsgBox ("External Links Spider run successfully in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0043 Case 3
0044 WebRefs_Checker_Pages_Gen
0045 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebRefs_Checker_Pages_Gen"";")
0046 WebRefs_Checker_Pages_Gen
0047 Duration = Round((Now() - Start_Time) * 24 * 60, 1)
0048 rsTableToRead.Edit
0049 rsTableToRead.Fields(1) = Now()
0050 rsTableToRead.Fields(2) = Duration
0051 rsTableToRead.Update
0052 Set rsTableToRead = Nothing
0053 MsgBox ("External Links Test Pages output successfully in " & Round((Now() - Start_Time) * 24 * 60, 1) & " minutes.")
0054 Case 4
0055 DoCmd.Close acTable, "WebRef_Missing_IDs"
0056 DoCmd.OpenTable ("WebRef_Missing_IDs")
0057 DoCmd.OpenQuery ("WebRefs_Duplicates")
0058 DoCmd.OpenQuery ("WebRefs_Error_List")
0059 DoCmd.OpenQuery ("WebRefs_Error_Summary")
0060 Case 5
0061 Translate_Webrefs
0062 Case 6
0063 Map_WebRefs
0064 Case Else
0065 End
0066End Select
0067End Sub

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



Source Code of: cmdWebsiteMaintenanceDashboard_Click
Procedure Type: Private Sub
Module: Form_MainForm
Lines of Code: 34
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Private Sub cmdWebsiteMaintenanceDashboard_Click()
0002Dim strMessage As String
0003Dim StartTime As Double
0004Dim rsTableToRead As Recordset
0005Dim rsTableToRead2 As Recordset
0006Dim Duration As Double
0007Dim strRunTime As String
0008Dim RunDate As Date
0009 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebsiteMaintenanceDashboard"";")
0010RunDate = rsTableToRead.Fields(1)
0011strRunTime = Round(rsTableToRead.Fields(2), 1)
0012strMessage = "Do you want to regenerate the ""Website: Maintenance Dashboard"" page?"""
0013strMessage = strMessage & Chr$(10) & "The last run on " & RunDate & " took " & strRunTime & " minutes."
0014RootCreated = ""
0015If MsgBox(strMessage, vbYesNo) = vbYes Then
0016 StartTime = Now()
0017 Monthly_Report_Note1010_Update
0018 Duration = Round((Now() - StartTime) * 24 * 60, 1)
0019 rsTableToRead.Edit
0020 rsTableToRead.Fields(1) = Now()
0021 rsTableToRead.Fields(2) = Duration
0022 rsTableToRead.Update
0023Else
0024 Exit Sub
0025End If
0026If Duration < 1 Then
0027 Duration = Round((Now() - StartTime) * 24 * 60 * 60)
0028 MsgBox "Maintenance Dashboard Creation Complete in " & Duration & " seconds.", vbOKOnly, "Create Maintenance Dashboard Web Page"
0029Else
0030 MsgBox "Maintenance Dashboard Creation Complete in " & Duration & " minutes.", vbOKOnly, "Create Maintenance Dashboard Web Page"
0031End If
0032Set rsTableToRead = Nothing
0033Set rsTableToRead2 = Nothing
0034End Sub

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



Source Code of: Functor_01
Procedure Type: Public Function
Module: Functors
Lines of Code: 28
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Function Functor_01(Note_ID, Note_Title, Note_Text, YTD)
0002'Quarterly report: activity insert
0003Dim rs As Recordset
0004Dim strQuery As String
0005Dim strReport_Date As String
0006Dim strYear As String
0007Dim strQuarter As String
0008'Find the Report Year & Quarter
0009 OK = Find_Report_Period(Note_Title, strYear, strQuarter)
0010If YTD = "Yes" Then
0011 strReport_Date = strYear
0012 If strQuarter <> "Q4" Then
0013 strReport_Date = strReport_Date - 1
0014 End If
0015Else
0016 strReport_Date = strYear & "_" & strQuarter
0017End If
0018 strQuery = "SELECT Status_Tasklists.Report_Text FROM Status_Tasklists WHERE Status_Tasklists.Note_ID = " & Note_ID & " AND Status_Tasklists.Note_Period = """ & strReport_Date & """;"
0019Set rs = CurrentDb.OpenRecordset(strQuery)
0020If Not rs.EOF Then
0021 rs.MoveFirst
0022 Note_Text = rs.Fields(0)
0023 Functor_01 = "Yes"
0024Else
0025 Functor_01 = "No"
0026End If
0027Set rs = Nothing
0028End Function

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



Source Code of: StartTimer
Procedure Type: Public Sub
Module: StopWatch
Lines of Code: 3

Line-No. / Ref.Code Line
0001Public Sub StartTimer()
0002 mlngStart = GetTickCount
0003End Sub

Go To Top of This Page
Link to VBA Code Control Page



Source Code of: Translate_Webrefs
Procedure Type: Public Sub
Module: Testing
Lines of Code: 171
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Translate_Webrefs()
0002Dim rsWebRef_Translations As Recordset
0003Dim rsObject As Recordset
0004Dim strQuery As String
0005Dim Old_WebRef As String
0006Dim New_WebRef As String
0007Dim Object As String
0008Dim iUpdates As Long
0009Dim Duration As Single
0010Dim RunStartTime As Date
0011Dim Message As String
0012Message = MsgBox("Translate WebRefs? Update the WebRefs_Translation Table?", vbYesNoCancel)
0013If Message = vbCancel Then
0014 End
0015Else
0016 If Message = vbYes Then
0017 DoCmd.OpenTable ("WebRefs_Translation")
0018 DoCmd.OpenQuery ("qrySearch_Webrefs_Table")
0019 End
0020 End If
0021End If
0022iUpdates = 0
0023RunStartTime = Now()
0024 strQuery = "SELECT * FROM WebRefs_Translation WHERE [Done?] = False;"
0025Set rsWebRef_Translations = CurrentDb.OpenRecordset(strQuery)
0026If rsWebRef_Translations.EOF Then
0027 MsgBox ("No translations to do!")
0028 End
0029Else
0030 rsWebRef_Translations.MoveFirst
0031End If
0032Do Until rsWebRef_Translations.EOF
0033 Old_WebRef = "+W" & rsWebRef_Translations.Fields(0) & "W+"
0034 New_WebRef = "+W" & rsWebRef_Translations.Fields(1) & "W+"
0035 'Translate Notes
0036 strQuery = "SELECT Notes.ID, Notes.Item_Text FROM Notes WHERE (((Notes.Item_Text) Like ""*" & Old_WebRef & "*""));"
0037 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0038 If Not rsObject.EOF Then
0039 rsObject.MoveFirst
0040 Do Until rsObject.EOF
0041 Object = rsObject.Fields(1)
0042 Object = Replace(Object, Old_WebRef, New_WebRef)
0043 rsObject.Edit
0044 rsObject.Fields(1) = Object
0045 rsObject.Update
0046 iUpdates = iUpdates + 1
0047 Debug.Print Now() & " - "; "Note:" & rsObject.Fields(0); " Old_WebRef: "; Old_WebRef
0048 rsObject.MoveNext
0049 Loop
0050 End If
0051 Set rsObject = Nothing
0052 'Translate Notes_Archive
0053 strQuery = "SELECT Notes_Archive.ID, Notes_Archive.Item_Text FROM Notes_Archive WHERE (((Notes_Archive.Item_Text) Like ""*" & Old_WebRef & "*""));"
0054 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0055 If Not rsObject.EOF Then
0056 rsObject.MoveFirst
0057 Do Until rsObject.EOF
0058 Object = rsObject.Fields(1)
0059 Object = Replace(Object, Old_WebRef, New_WebRef)
0060 rsObject.Edit
0061 rsObject.Fields(1) = Object
0062 rsObject.Update
0063 iUpdates = iUpdates + 1
0064 Debug.Print Now() & " - "; "Note_Archive:" & rsObject.Fields(0); " Old_WebRef: "; Old_WebRef
0065 rsObject.MoveNext
0066 Loop
0067 End If
0068 Set rsObject = Nothing
0069 'Translate Book Abstracts
0070 strQuery = "SELECT Books.ID1, Books.Abstract FROM Books WHERE (((Books.Abstract) Like ""*" & Old_WebRef & "*""));"
0071 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0072 If Not rsObject.EOF Then
0073 rsObject.MoveFirst
0074 Do Until rsObject.EOF
0075 Object = rsObject.Fields(1)
0076 Object = Replace(Object, Old_WebRef, New_WebRef)
0077 rsObject.Edit
0078 rsObject.Fields(1) = Object
0079 rsObject.Update
0080 iUpdates = iUpdates + 1
0081 Debug.Print Now() & " - "; "Book Abstract:" & rsObject.Fields(0); " Old_WebRef: "; Old_WebRef
0082 rsObject.MoveNext
0083 Loop
0084 End If
0085 Set rsObject = Nothing
0086 'Translate Book Comments
0087 strQuery = "SELECT Books.ID1, Books.Comments FROM Books WHERE (((Books.Comments) Like ""*" & Old_WebRef & "*""));"
0088 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0089 If Not rsObject.EOF Then
0090 rsObject.MoveFirst
0091 Do Until rsObject.EOF
0092 Object = rsObject.Fields(1)
0093 Object = Replace(Object, Old_WebRef, New_WebRef)
0094 rsObject.Edit
0095 rsObject.Fields(1) = Object
0096 rsObject.Update
0097 iUpdates = iUpdates + 1
0098 Debug.Print Now() & " - "; "Book Comment:" & rsObject.Fields(0); " Old_WebRef: "; Old_WebRef
0099 rsObject.MoveNext
0100 Loop
0101 End If
0102 Set rsObject = Nothing
0103 'Translate Paper Abstracts
0104 strQuery = "SELECT Papers.ID, Papers.Abstract FROM Papers WHERE (((Papers.Abstract) Like ""*" & Old_WebRef & "*""));"
0105 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0106 If Not rsObject.EOF Then
0107 rsObject.MoveFirst
0108 Do Until rsObject.EOF
0109 Object = rsObject.Fields(1)
0110 Object = Replace(Object, Old_WebRef, New_WebRef)
0111 rsObject.Edit
0112 rsObject.Fields(1) = Object
0113 rsObject.Update
0114 iUpdates = iUpdates + 1
0115 Debug.Print Now() & " - "; "Paper Abstract:" & rsObject.Fields(0); " Old_WebRef: "; Old_WebRef
0116 rsObject.MoveNext
0117 Loop
0118 End If
0119 Set rsObject = Nothing
0120 'Translate Paper Comments
0121 strQuery = "SELECT Papers.ID, Papers.Comments FROM Papers WHERE (((Papers.Comments) Like ""*" & Old_WebRef & "*""));"
0122 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0123 If Not rsObject.EOF Then
0124 rsObject.MoveFirst
0125 Do Until rsObject.EOF
0126 Object = rsObject.Fields(1)
0127 Object = Replace(Object, Old_WebRef, New_WebRef)
0128 rsObject.Edit
0129 rsObject.Fields(1) = Object
0130 rsObject.Update
0131 iUpdates = iUpdates + 1
0132 Debug.Print Now() & " - "; "Paper Comment:" & rsObject.Fields(0); " Old_WebRef: "; Old_WebRef
0133 rsObject.MoveNext
0134 Loop
0135 End If
0136 Set rsObject = Nothing
0137 'Translate Authors
0138 strQuery = "SELECT Authors.Author_ID, Authors.Author_Narrative FROM Authors WHERE (((Authors.Author_Narrative) Like ""*" & Old_WebRef & "*""));"
0139 Set rsObject = CurrentDb.OpenRecordset(strQuery)
0140 If Not rsObject.EOF Then
0141 rsObject.MoveFirst
0142 Do Until rsObject.EOF
0143 Object = rsObject.Fields(1)
0144 Object = Replace(Object, Old_WebRef, New_WebRef)
0145 rsObject.Edit
0146 rsObject.Fields(1) = Object
0147 rsObject.Update
0148 iUpdates = iUpdates + 1
0149 Debug.Print Now() & " - "; "Author Abstract:" & rsObject.Fields(0); " Old_WebRef: "; Old_WebRef
0150 rsObject.MoveNext
0151 Loop
0152 End If
0153 Set rsObject = Nothing
0154 rsWebRef_Translations.Edit
0155 rsWebRef_Translations.Fields(2) = True
0156 rsWebRef_Translations.Update
0157 rsWebRef_Translations.MoveNext
0158Loop
0159Set rsWebRef_Translations = Nothing
0160'Flag translated Webrefs as Defunct
0161 strQuery = "UPDATE WebRefs_Translation INNER JOIN Webrefs_Table ON WebRefs_Translation.WebRef_Old = Webrefs_Table.ID SET Webrefs_Table.[Defunct?] = True;"
0162DoCmd.RunSQL (strQuery)
0163 DoCmd.OpenQuery ("WebRefs_Translation_Check")
0164Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0165If Duration < 1 Then
0166 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0167 MsgBox "WebRefs Translated in " & Duration & " seconds. " & iUpdates & " records updated.", vbOKOnly, "Translate WebRefs"
0168Else
0169 MsgBox "WebRefs Translated in " & Duration & " minutes. " & iUpdates & " records updated.", vbOKOnly, "Translate WebRefs"
0170End If
0171End Sub

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



Source Code of: WebpageGenBooksRecent
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 27
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub WebpageGenBooksRecent()
0002Dim StartTime As Double
0003Dim rsTableToRead As Recordset
0004Dim Duration As Double
0005Dim strRunTime As String
0006Dim RunDate As Date
0007 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""WebpageGenBooksRecent"";")
0008RunDate = rsTableToRead.Fields(1)
0009strRunTime = Round(rsTableToRead.Fields(2), 1)
0010StartTime = Now()
0011strControlTable = "Books_Table_Recent"
0012strOutputFileShort = "BookCatalogRecent"
0013strOutputFolder = "C:\Theo's Files\Websites\Theo's Website\"
0014strOutputFile = strOutputFolder & strOutputFileShort
0015 strDataQuery = "Books - Recent"
0016strSplitTable = "No"
0017strControlBreakType = "Initial"
0018strControlBreakType2 = ""
0019Main_Header = "No"
0020 CreatePapersWebTable
0021Duration = Round((Now() - StartTime) * 24 * 60, 1)
0022rsTableToRead.Edit
0023rsTableToRead.Fields(1) = Now()
0024rsTableToRead.Fields(2) = Duration
0025rsTableToRead.Update
0026Set rsTableToRead = Nothing
0027End Sub

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



Source Code of: WebpageGenNoteBooksLinks
Procedure Type: Public Sub
Module: Webpage_Generators
Lines of Code: 13

Line-No. / Ref.Code Line
0001Public Sub WebpageGenNoteBooksLinks()
0002 strControlTable = "Note_Book_Links"
0003strOutputFileShort = "NoteBookLinks"
0004strOutputFolder = "C:\Theo's Files\Websites\Theo's Website\"
0005strOutputFile = strOutputFolder & strOutputFileShort
0006 strDataQuery = "Note_Book_Links_List"
0007strSplitTable = "No"
0008strControlBreakType = "Initial"
0009strControlBreakType2 = ""
0010Main_Header = "No"
0011RootCreated = ""
0012 CreatePapersWebTable
0013End Sub

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



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