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 6 (3 items)

CreateAbstractWebPagesCreateModulesWebpageWebrefs_Update.

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

Go to top of page



Source Code of: CreateAbstractWebPages
Procedure Type: Public Sub
Module: General_Subroutines
Lines of Code: 469
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub CreateAbstractWebPages()
0002Dim fsoTextFile As FileSystemObject
0003Dim tsTextFile As TextStream
0004Dim rsTableToRead As Recordset
0005Dim rsTableToRead2 As Recordset
0006Dim rsTableControl As Recordset
0007Dim rsCitings As Recordset
0008Dim rsNote As Recordset
0009Dim strControlQuery As String
0010Dim strLine As String
0011Dim strText As String
0012Dim strComment As String
0013Dim strAbstract As String
0014Dim i As Integer
0015Dim x As Long
0016Dim StartTime As Date
0017Dim RunStartTime As Date
0018Dim Duration As Double
0019Dim Response As String
0020Dim strMessage As String
0021Dim Total_Run As Single
0022Dim Run_Type As String
0023Dim All_Done As Boolean
0024Dim RunDate As Date
0025Dim strAuthor As String
0026Dim NoteID As Integer
0027Dim SubDirectory As String
0028Dim iCount As Long
0029Dim strLine1 As String
0030Dim Link_Count As Integer
0031Dim Link_1 As String
0032Dim Link_2 As String
0033Dim Link_3 As String
0034Dim Link_4 As String
0035Dim Link_4_Saved As String
0036Dim Link_5 As String
0037Dim Link_6 As String
0038Dim Link_Authors As String
0039Dim strTable As String
0040Dim strQuery As String
0041Dim strNote_Date As String
0042Dim strHR As String
0043Dim sw As StopWatch
0044Dim sw2 As StopWatch
0045'Test_Flag = True
0046If Test_Flag = True Then
0047 Set sw = New StopWatch
0048 Set sw2 = New StopWatch
0049End If
0050iCount = 0
0051Set fsoTextFile = New FileSystemObject
0052NotePaperLinksDB_Open = "Closed"
0053Cross_Reference_Table_Open = False
0054Set rsCross_Reference_Table = Nothing
0055Total_Run = 0
0056If automatic_processing = "Yes" Then
0057 Run_Type = "Regen"
0058 Response = vbYes
0059 GoTo Automatic
0060End If
0061Response = MsgBox("Do you want to regenerate pages for changed Abstracts only?", vbYesNoCancel)
0062If Response = vbYes Then
0063 Response = MsgBox("Do you want to include pages with embedded Notes?", vbYesNo + vbDefaultButton2)
0064 If Response = vbYes Then
0065 Response = MsgBox("Do you want to include pages with embedded Temp Notes only?", vbYesNo + vbDefaultButton1)
0066 If Response = vbYes Then
0067 strControlQuery = "Abstracts_Changed_List_Plus+TempNotes"
0068 Else
0069 strControlQuery = "Abstracts_Changed_List_Plus+Notes"
0070 Response = vbYes
0071 End If
0072 Else
0073 strControlQuery = "Abstracts_Changed_List"
0074 Response = vbYes
0075 End If
0076 Run_Type = "Changed"
0077Else
0078 Run_Type = "Regen"
0079 If Response = vbNo Then
0080 Response = Paper_Abstracts_Selection
0081 If Response = vbYes Then
0082 Run_Type = "Selected"
0083 strControlQuery = "Abstracts_Selected_List"
0084 Else
0085 Response = MsgBox("Do you want to regenerate Abstract pages for Papers with IDs in particular ranges?", vbYesNoCancel)
0086 If Response = vbYes Then
0087 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Paper_Abstract_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0088 If Not rsTableToRead.EOF Then
0089 rsTableToRead.MoveFirst
0090 strMessage = "Run for the following range" & IIf(rsTableToRead.RecordCount > 1, "s", "") & "?" & Chr(10) & Chr(10)
0091 Do While Not rsTableToRead.EOF
0092 strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & "m (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & "d)" & Chr(10)
0093 Total_Run = Total_Run + Nz(rsTableToRead.Fields(5))
0094 rsTableToRead.MoveNext
0095 Loop
0096 strMessage = strMessage & "Total = " & Round(Total_Run, 0) & "m." & Chr(10) & Chr(10)
0097 Else
0098 DoCmd.OpenTable ("Paper_Abstract_Ranges")
0099 MsgBox ("No Ranges selected. Update the Paper_Abstract_Ranges Table.")
0100 End
0101 End If
0102 Total_Run = 0
0103 Set rsTableToRead = CurrentDb.OpenRecordset("SELECT * FROM Paper_Abstract_Ranges WHERE [Select?] = False ORDER BY ID_Start;")
0104 If Not rsTableToRead.EOF Then
0105 strMessage = strMessage & "Not selected:- " & Chr(10) & Chr(10)
0106 rsTableToRead.MoveFirst
0107 Do While Not rsTableToRead.EOF
0108 strMessage = strMessage & rsTableToRead.Fields(0) & ": " & rsTableToRead.Fields(1) & "-" & rsTableToRead.Fields(2) & ": " & Round(rsTableToRead.Fields(5), 0) & " mins (" & Round(rsTableToRead.Fields(4), 0) & ", " & Round((Now() - Round(rsTableToRead.Fields(4))), 0) & " days)" & Chr(10)
0109 Total_Run = Total_Run + rsTableToRead.Fields(5)
0110 rsTableToRead.MoveNext
0111 Loop
0112 strMessage = strMessage & "Total o/s = " & Round(Total_Run, 0) & "m." & Chr(10) & Chr(10)
0113 End If
0114 Response = MsgBox(strMessage, vbYesNo)
0115 If Response = vbNo Then
0116 DoCmd.OpenTable ("Paper_Abstract_Ranges")
0117 MsgBox ("Update the Paper_Abstract_Ranges Table.")
0118 End
0119 End If
0120 End If
0121 End If
0122 End If
0123End If
0124Automatic:
0125If Response <> vbYes Then
0126 MsgBox ("Try again!")
0127 Exit Sub
0128End If
0129RunStartTime = Now()
0130StartTime = Now()
0131 OK = Convert_Webrefs("Paper", "Full")
0132If Run_Type = "Changed" Or Run_Type = "Selected" Then
0133 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0134 If rsTableToRead.EOF Then
0135 MsgBox ("No changed abstracts!")
0136 Exit Sub
0137 End If
0138Else
0139 Set rsTableToRead2 = CurrentDb.OpenRecordset("SELECT * FROM Paper_Abstract_Ranges WHERE [Select?] = True ORDER BY ID_Start;")
0140 If rsTableToRead2.EOF Then
0141 All_Done = True
0142 Else
0143 All_Done = False
0144 rsTableToRead2.MoveFirst
0145 End If
0146End If
0147All_Done = False
0148'Output Abstract Pages
0149Do Until All_Done = True
0150 If Run_Type = "Changed" Or Run_Type = "Selected" Then
0151 All_Done = True
0152 Else
0153 'Generate records list
0154 strControlQuery = "SELECT * FROM Abstracts_List WHERE (ID >= " & rsTableToRead2.Fields(1) & " AND ID <= " & rsTableToRead2.Fields(2) & ") ORDER BY ID;"
0155 Set rsTableToRead = CurrentDb.OpenRecordset(strControlQuery)
0156 If Not rsTableToRead.EOF Then
0157 rsTableToRead.MoveFirst
0158 End If
0159 End If
0160 strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = ""Abstract"") And ((Website_Control.Section) = ""Text"")) ORDER BY Website_Control.Line;"
0161 Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0162 If Not rsTableToRead.EOF Then
0163 rsTableToRead.MoveFirst
0164 End If
0165 Do While Not rsTableToRead.EOF
0166 If Test_Flag = True Then
0167 sw.StartTimer
0168 End If
0169 Clear_Colour_Usage
0170 strFolder = TheoWebsiteRoot & "\Abstracts\Abstract_" & Right(Str(Int(rsTableToRead.Fields(0) / 1000) + 1000000), 2) & "\"
0171 strFileName = "Abstract_" & rsTableToRead.Fields(0) & ".htm"
0172 Set tsTextFile = fsoTextFile.CreateTextFile(strFolder & strFileName, True, True)
0173 rsTableControl.MoveFirst
0174 OK = Zap_Cross_References("P", rsTableToRead.Fields(0), 0)
0175 'NameRef = 0
0176 Do While Not rsTableControl.EOF
0177 strLine = rsTableControl.Fields(0) & ""
0178 OK = Replace_Timestamp(strLine)
0179 x = InStr(1, strLine, "**HEAD_TITLE**")
0180 If x > 0 Then
0181 strLine = Left(strLine, x - 1) & rsTableToRead.Fields(1) & " - " & rsTableToRead.Fields(2) & " (Theo Todman's Book Collection - Paper Abstracts) " & Mid(strLine, x + 14, Len(strLine))
0182 End If
0183 x = InStr(1, strLine, "**Author**")
0184 If x > 0 Then
0185 strAuthor = rsTableToRead.Fields(1)
0186 OK = Author_Reference_String(strAuthor, 2)
0187 strLine = Left(strLine, x - 1) & strAuthor & Mid(strLine, x + 10, Len(strLine))
0188 End If
0189 x = InStr(1, strLine, "**Title**")
0190 If x > 0 Then
0191 strLine = Left(strLine, x - 1) & "<A HREF = """ & "../../PaperSummaries/PaperSummary_" & Right(Str(Int(rsTableToRead.Fields(0) / 1000) + 1000000), 2) & "/" & "PaperSummary_" & rsTableToRead.Fields(0) & ".htm" & """>" & rsTableToRead.Fields(2) & "</A>" & Mid(strLine, x + 9, Len(strLine))
0192 End If
0193 x = InStr(1, strLine, "**Source**")
0194 If x > 0 Then
0195 If rsTableToRead.Fields(5) & "" <> "" Then
0196 strLine = Left(strLine, x - 1) & "Source: " & rsTableToRead.Fields(5) & Mid(strLine, x + 10, Len(strLine))
0197 Else
0198 strLine = Left(strLine, x - 1) & rsTableToRead.Fields(5) & Mid(strLine, x + 10, Len(strLine))
0199 End If
0200 End If
0201 x = InStr(1, strLine, "**LINK**")
0202 If x > 0 Then
0203 Link_Count = 0
0204 Link_1 = ""
0205 Link_2 = ""
0206 Link_3 = ""
0207 Link_4 = ""
0208 Link_5 = ""
0209 Link_6 = ""
0210 Link_Authors = ""
0211 Link_1 = "<A HREF = """ & "../../PaperSummaries/PaperSummary_" & Right(Str(Int(rsTableToRead.Fields(0) / 1000) + 1000000), 2) & "/" & "PaperSummary_" & rsTableToRead.Fields(0) & ".htm" & """>Paper Statistics</A>"
0212 Link_Count = Link_Count + 1
0213 'Output Book, Paper & Notes citing links
0214 If Test_Flag = True Then
0215 sw2.StartTimer
0216 End If
0217 strControlQuery = "SELECT Paper_Citings_List_New.* FROM Paper_Citings_List_New WHERE Paper_Citings_List_New.Paper_ID = " & rsTableToRead.Fields(0) & ";"
0218 Set rsCitings = CurrentDb.OpenRecordset(strControlQuery)
0219 If Not rsCitings.EOF Then
0220 rsCitings.MoveFirst
0221 Set rsCitings = Nothing
0222 Link_2 = "<A HREF = ""../../PaperSummaries/PaperSummary_" & Mid(rsTableToRead.Fields(0) + 1000000, 3, 2) & "/PaperCitings_" & rsTableToRead.Fields(0) & ".htm"">Books / Papers Citing this Paper</A>"
0223 Link_Count = Link_Count + 1
0224 End If
0225 If Test_Flag = True Then
0226 Debug.Print Now(); strFileName; sw2.EndTimer; "Milliseconds"; " Paper_Citings"
0227 sw2.StartTimer
0228 End If
0229 strControlQuery = "SELECT Note_Paper_Links.* FROM Note_Paper_Links WHERE Note_Paper_Links.Paper = " & rsTableToRead.Fields(0) & " AND Note_Paper_Links.Origin = ""Note"";"
0230 Set rsCitings = CurrentDb.OpenRecordset(strControlQuery)
0231 If Not rsCitings.EOF Then
0232 rsCitings.MoveFirst
0233 Link_3 = "<A HREF = ""../../PaperSummaries/PaperSummary_" & Mid(rsTableToRead.Fields(0) + 1000000, 3, 2) & "/PapersToNotes_" & rsTableToRead.Fields(0) & ".htm"">Notes Citing this Paper</A>"
0234 Link_Count = Link_Count + 1
0235 Set rsCitings = Nothing
0236 End If
0237 If Test_Flag = True Then
0238 Debug.Print Now(); strFileName; sw2.EndTimer; "Milliseconds"; " Paper_Note_Counts"
0239 End If
0240 'Add Author Citings
0241 If Test_Flag = True Then
0242 sw2.StartTimer
0243 End If
0244 strControlQuery = "SELECT Authors.Author_Name FROM Authors INNER JOIN Cross_Reference ON Authors.Author_ID = Cross_Reference.Calling_ID WHERE (((Cross_Reference.Called_ID) = " & rsTableToRead.Fields(0) & ") And ((Cross_Reference.Calling_Type) = ""A"") And ((Cross_Reference.Called_Type) = ""P"")) ORDER BY Authors.Author_Name;"
0245 Set rsCitings = CurrentDb.OpenRecordset(strControlQuery)
0246 If Not rsCitings.EOF Then
0247 rsCitings.MoveFirst
0248 Link_Authors = "<hr><p><B>Authors Citing this Paper</B>: <A HREF = ""../../Authors/" & Left(rsCitings.Fields(0), 1) & "/Author_" & rsCitings.Fields(0) & ".htm"">" & rsCitings.Fields(0) & "</A>"
0249 rsCitings.MoveNext
0250 Do While Not rsCitings.EOF
0251 strLine1 = strLine1 & ", <A HREF = ""../../Authors/" & Left(rsCitings.Fields(0), 1) & "/Author_" & rsCitings.Fields(0) & ".htm"">" & rsCitings.Fields(0) & "</A>"
0252 Link_Authors = Link_Authors & ", <A HREF = ""../../Authors/" & Left(rsCitings.Fields(0), 1) & "/Author_" & rsCitings.Fields(0) & ".htm"">" & rsCitings.Fields(0) & "</A>"
0253 rsCitings.MoveNext
0254 Loop
0255 Link_Authors = Link_Authors & "</p>"
0256 Set rsCitings = Nothing
0257 End If
0258 If Test_Flag = True Then
0259 Debug.Print Now(); strFileName; sw2.EndTimer; "Milliseconds"; " Authors Citing this Paper"
0260 End If
0261 If rsTableToRead.Fields(6) & "" <> "" Then
0262 NoteID = rsTableToRead.Fields(6)
0263 strQuery = "SELECT Note_Groups.Note_Group FROM Notes INNER JOIN Note_Groups ON Notes.Note_Group = Note_Groups.ID WHERE (((Notes.ID)=" & NoteID & "));"
0264 Set rsNote = CurrentDb.OpenRecordset(strQuery)
0265 SubDirectory = Find_New_Directory(NoteID)
0266 SubDirectory = SubDirectory & "/Notes_"
0267 If rsNote.Fields(0) = "Supervisions" Then
0268 SubDirectory = "../../Secure_Jen/Notes_" & SubDirectory
0269 Else
0270 SubDirectory = "../../Notes/Notes_" & SubDirectory
0271 End If
0272 Link_4_Saved = "<A HREF = """ & SubDirectory & rsTableToRead.Fields(6).Value & ".htm"">"
0273 Link_4 = Link_4_Saved & "Link to Latest Write-Up Note</A>"
0274 Link_Count = Link_Count + 1
0275 Else
0276 NoteID = 0
0277 End If
0278 If InStr(rsTableToRead.Fields(3), "|Colour_2|") > 0 Then
0279 If Len(rsTableToRead.Fields(3)) > 1000 Then
0280 'Advance warning for citation-text
0281 Link_5 = "<A HREF=""#ColourConventions"">Text Colour-Conventions</a>"
0282 Link_Count = Link_Count + 1
0283 End If
0284 SubDirectory = Find_New_Directory(1025)
0285 SubDirectory = SubDirectory & "/Notes_"
0286 Link_6 = "<A HREF = ""../../Notes/Notes_" & SubDirectory & "1025.htm"">Disclaimer</A>"
0287 Link_Count = Link_Count + 1
0288 End If
0289 strTable = "<CENTER><TABLE class = ""Bridge"" WIDTH=" & Link_Count * 200 & "><tr>"
0290 If Link_1 <> "" Then
0291 strTable = strTable & "<td>" & Link_1 & "</td>"
0292 End If
0293 If Link_2 <> "" Then
0294 strTable = strTable & "<td>" & Link_2 & "</td>"
0295 End If
0296 If Link_3 <> "" Then
0297 strTable = strTable & "<td>" & Link_3 & "</td>"
0298 End If
0299 If Link_4 <> "" Then
0300 strTable = strTable & "<td>" & Link_4 & "</td>"
0301 End If
0302 If Link_5 <> "" Then
0303 strTable = strTable & "<td>" & Link_5 & "</td>"
0304 End If
0305 If Link_6 <> "" Then
0306 strTable = strTable & "<td>" & Link_6 & "</td>"
0307 End If
0308 strTable = strTable & "</tr></TABLE></CENTER>"
0309 strLine = Left(strLine, x - 1) & strTable & Link_Authors & Mid(strLine, x + 8, Len(strLine))
0310 End If
0311 x = InStr(1, strLine, "**TEXT**")
0312 If x > 0 Then
0313 If Test_Flag = True Then
0314 sw2.StartTimer
0315 End If
0316 strText = "|Colour_1|"
0317 strAbstract = Trim(rsTableToRead.Fields(3) & "")
0318 strComment = Trim(rsTableToRead.Fields(4)) & ""
0319 If Len(strAbstract) > 0 Then
0320 If Len(strComment) > 3000 Then
0321 'Concatenate Abstract & Comment - Comment is overflow from Abstract
0322 strAbstract = strAbstract & strComment
0323 strComment = ""
0324 End If
0325 'Encode any unencoded references first - otherwise they never get encoded!
0326 strAbstract = ImageRef(strAbstract, "Abstract", "P", rsTableToRead.Fields(0), 0)
0327 strText = strText & strAbstract
0328 Else
0329 strAbstract = ""
0330 End If
0331 If strComment <> "" Then
0332 If Len(strComment) > 0 Then
0333 'Encode any unencoded references first - otherwise they never get encoded!
0334 strComment = ImageRef(strComment, "Abstract", "P", rsTableToRead.Fields(0), 0)
0335 strText = strText & IIf(Len(strAbstract) > 0, "<hr>", "") & "|Colour_1|<B>Comment: </B>" & IIf(Left(strComment, 1) = "|", "", "<BR><BR>") & strComment & "<BR>"
0336 End If
0337 End If
0338 'Write out Write-up Note (if any)
0339 If NoteID > 0 Then
0340 strQuery = "SELECT Notes.ID, Notes.Item_Title, Notes.Item_Text, Notes.Last_Changed, Notes.[Private?] FROM Notes WHERE (((Notes.ID)=" & NoteID & "));"
0341 Set rsNote = CurrentDb.OpenRecordset(strQuery)
0342 If Not rsNote.EOF Then
0343 If rsNote.Fields(4) & "" = "No" Then
0344 strNote_Date = rsNote.Fields(3) & ""
0345 If strNote_Date <> "" Then
0346 strNote_Date = CDate(strNote_Date / 1000)
0347 Else
0348 strNote_Date = Now()
0349 End If
0350 '****************
0351 If Len(strComment) + Len(strAbstract) > 0 Then
0352 strHR = "<hr>"
0353 Else
0354 strHR = ""
0355 End If
0356 strText = strText & "|Colour_1|" & strHR & "<br><B><u>Write-up++FN|..||.|This is the write-up as it was when this Abstract was last output, with text as at the timestamp indicated (" & strNote_Date & "). |.|" & Link_4 & ". |..|++</u> (as at " & strNote_Date & "): " & Link_4_Saved & rsNote.Fields(1) & "</a></B><BR><br>" & ImageRef(rsNote.Fields(2), "Abstract", "P", rsTableToRead.Fields(0), 0)
0357 End If
0358 End If
0359 End If
0360 'In-page Footnotes, Etc.
0361 OK = Reference_FootNotes("P", rsTableToRead.Fields(0), strText)
0362 strText = strText & "|Colour_1|<HR>"
0363 strLine = Left(strLine, x - 1) & strText & Mid(strLine, x + 8, Len(strLine))
0364 strLine = Remove_Dummy_Ref(strLine)
0365 strLine = WebEncode(strLine)
0366 OK = Mark_Colours(strLine)
0367 OK = Reference_Files(strLine, "P", rsTableToRead.Fields(0), 0) 'Replace the PDF Files References by hyperlinks
0368 OK = Reference_Notes(strLine, "P", rsTableToRead.Fields(0), 0, 2, "Abstract_Direct", "Paper", rsTableToRead.Fields(0)) 'Replace the Notes References by hyperlinks
0369 OK = Reference_Notes(strLine, "P", rsTableToRead.Fields(0), 0, 2, "Abstract", "Paper", rsTableToRead.Fields(0)) 'Replace the Notes References by hyperlinks
0370 OK = Reference_Papers(strLine, "P", rsTableToRead.Fields(0), 0) 'Replace the Papers References by hyperlinks
0371 OK = Reference_Author(strLine, "P", rsTableToRead.Fields(0), 0) 'Replace the Author References by hyperlinks
0372 OK = Reference_Note_Links(strLine, "P", rsTableToRead.Fields(0), 0) 'Replace the Note_Link References by hyperlinks
0373 OK = Reference_Books(strLine, "P", rsTableToRead.Fields(0), 0) 'Replace the Books References by hyperlinks
0374 OK = Reference_Webrefs(strLine, "P", rsTableToRead.Fields(0), 0)
0375 OK = Reference_Reference(strLine)
0376 OK = Reference_Code(strLine)
0377 OK = Reference_Queries(strLine)
0378 OK = Reference_Tables(strLine)
0379 strLine = ReplaceCode(strLine, Chr(13) & Chr(10), "<BR>")
0380 'Bullets
0381 strLine = NumberedBullets(strLine)
0382 strLine = Bullets(strLine)
0383 strLine = strLine & "<a name=""ColourConventions""></a><p><b>Text Colour Conventions (see <A HREF=""../../Notes/Notes_10/Notes_1025.htm"">disclaimer</a>)</b></p><OL TYPE=""1"">"
0384 For i = 0 To 19
0385 If Colour_Table(i, 4) = "1" Then
0386 strLine = strLine & "<LI><FONT COLOR = """ & Colour_Table(i, 1) & """>" & Colour_Table(i, 2) & "</FONT>: " & Colour_Table(i, 3) & "</li>"
0387 End If
0388 Next i
0389 strLine = strLine & "</OL>"
0390 If Test_Flag = True Then
0391 Debug.Print Now(); strFileName; sw2.EndTimer; "Milliseconds"; " Process Text"
0392 End If
0393 End If
0394 'Write out
0395 If strLine <> "<tr><th></th></tr>" Then 'A bit of a fudge ... supposed to pick up where no source
0396 tsTextFile.WriteLine strLine
0397 End If
0398 rsTableControl.MoveNext
0399 Loop
0400 'Log Referencing Changes
0401 If Test_Flag = True Then
0402 sw2.StartTimer
0403 End If
0404 If Full_Regen = False Then
0405 DoCmd.OpenQuery ("Cross_Reference_Changes_Deletions_Add")
0406 End If
0407 If Test_Flag = True Then
0408 Debug.Print Now(); strFileName; sw2.EndTimer; "Milliseconds"; " Cross_Reference_Changes_Deletions_Add"
0409 End If
0410 If Test_Flag = True Then
0411 sw2.StartTimer
0412 End If
0413 If Full_Regen = False Then
0414 DoCmd.OpenQuery ("Cross_Reference_Changes_Additions_Add")
0415 End If
0416 If Test_Flag = True Then
0417 Debug.Print Now(); strFileName; sw2.EndTimer; "Milliseconds"; " Cross_Reference_Changes_Additions_Add"
0418 End If
0419 'Copy to Transfer
0420 If Test_Flag = True Then
0421 sw2.StartTimer
0422 End If
0423 OK = CopyToTransfer(strFolder, strFileName)
0424 If Test_Flag = True Then
0425 Debug.Print Now(); strFileName; sw2.EndTimer; "Milliseconds"; " CopyToTransfer"
0426 Debug.Print Now(); strFileName; sw.EndTimer; "Milliseconds"
0427 Stop
0428 End If
0429 iCount = iCount + 1
0430 rsTableToRead.MoveNext
0431 Loop
0432 If Run_Type <> "Changed" And Run_Type <> "Selected" Then
0433 'Update the Paper_Abstract_Ranges Table
0434 Duration = Now() - StartTime
0435 Duration = Duration * 24 * 60
0436 Duration = Round(Duration, 1)
0437 RunDate = Now()
0438 rsTableToRead2.Edit
0439 rsTableToRead2.Fields(4) = RunDate
0440 rsTableToRead2.Fields(5) = Duration
0441 rsTableToRead2.Update
0442 'Read Next Range
0443 rsTableToRead2.MoveNext
0444 If rsTableToRead2.EOF Then
0445 All_Done = True
0446 End If
0447 StartTime = Now()
0448 End If
0449Loop
0450Set rsNotePaperLinksDB = Nothing
0451Set rsTableToRead = Nothing
0452Set rsTableToRead2 = Nothing
0453Cross_Reference_Table_Open = False
0454Set rsCross_Reference_Table = Nothing
0455If Test_Flag = True Then
0456 Set sw = Nothing
0457 Set sw2 = Nothing
0458End If
0459 DoCmd.OpenQuery ("Cross_Reference_Idempotency_Zap")
0460If automatic_processing <> "Yes" Then
0461 Duration = Round((Now() - RunStartTime) * 24 * 60, 1)
0462 If Duration < 1 Then
0463 Duration = Round((Now() - RunStartTime) * 24 * 60 * 60)
0464 MsgBox Now() & ": Abstract Webpage Creation Complete in " & Duration & " seconds. " & iCount & " pages output.", vbOKOnly, "Create Paper Abstract Web Pages"
0465 Else
0466 MsgBox Now() & ": Abstract Webpage Creation Complete in " & Duration & " minutes. " & iCount & " pages output.", vbOKOnly, "Create Paper Abstract Web Pages"
0467 End If
0468End If
0469End Sub

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


Source Code of: CreateModulesWebpage
Procedure Type: Public Sub
Module: Documentation
Lines of Code: 60
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub CreateModulesWebpage()
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 Module As String
0011'Create the Documentation_Code_Modules File
0012'Read the data
0013 strDataQuery = "SELECT Code_Table.Module FROM Code_Table GROUP BY Code_Table.Module ORDER BY Code_Table.Module;"
0014Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery)
0015rsTableToRead.MoveFirst
0016'Create File
0017strOutputFileShort = SubSystem & "Documentation_Code_Modules"
0018Set tsTextFile = fsoTextFile2.CreateTextFile(strOutputFolder & strOutputFileShort & ".htm", True, True)
0019'Create Page Header
0020 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;"
0021Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0022rsTableControl.MoveFirst
0023Do While Not rsTableControl.EOF
0024 strLine = rsTableControl.Fields(0) & ""
0025 tsTextFile.WriteLine strLine
0026 rsTableControl.MoveNext
0027Loop
0028'Create Main Jump Table
0029iTableColumns = 5
0030Procedure_Type = "Modules"
0031Heading = "Modules"
0032 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns)
0033Do While Not rsTableToRead.EOF
0034 Module = rsTableToRead.Fields(0).Value
0035 'Create Module Jump Table
0036 iTableColumns = 5
0037 Procedure_Type = "Modules"
0038 Heading = "Module: " & Module
0039 OK = CreateDocumentationJumpTables(Procedure_Type, Heading, iTableColumns, Module)
0040 rsTableToRead.MoveNext
0041Loop
0042'Create link to main code jump-table
0043 strLine = "<A HREF=""" & SubSystem & "DocumentationControl.htm"">Link to VBA Code Control Page</A><br>"
0044tsTextFile.WriteLine strLine
0045'Finish File
0046'Page Footer
0047 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;"
0048Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery)
0049rsTableControl.MoveFirst
0050Do While Not rsTableControl.EOF
0051 strLine = rsTableControl.Fields(0)
0052 OK = Replace_Timestamp(strLine)
0053 tsTextFile.WriteLine strLine
0054 rsTableControl.MoveNext
0055Loop
0056'Copy to Transfer
0057strFileSuffix = strOutputFileShort
0058 OK = CopyToTransfer(strFolder, strFileSuffix & ".htm")
0059Set tsTextFile = Nothing
0060End Sub

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


Source Code of: Webrefs_Update
Procedure Type: Public Sub
Module: Spider
Lines of Code: 406
Go To End of This Procedure

Line-No. / Ref.Code Line
0001Public Sub Webrefs_Update()
0002Dim ie As InternetExplorer
0003Dim rsTableControl As Recordset
0004Dim i As Integer
0005Dim j As Integer
0006Dim k As Integer
0007Dim Requested_URL
0008Dim Returned_URL
0009Dim start As Date
0010Dim RunTime As Single
0011Dim Running_Hours As Single
0012Dim Issue As String
0013Dim Defunct As Boolean
0014Dim Update_Time As Double
0015Dim Recent_Check_Days As Single
0016Dim Recent_Check_Date As Single
0017Dim Recent_Check As Date
0018Dim Recent_Check_OK As Boolean
0019Dim Last_Bounce As Date
0020Dim Given_Up As Boolean
0021Dim Uncheckable As Boolean
0022Dim strQuery As String
0023Dim sBounce As Single
0024Dim max_Checks As Integer
0025Dim Webrefs_Option As String
0026Dim Option_Help As String
0027Dim Issue_Check As String
0028Dim YouTube_Check_Sent As String
0029Dim YouTube_Check_Returned As String
0030Dim Debug_Print As String
0031Dim Returned_URL_Saved As String
0032Dim Forced_Bounce As Boolean
0033Dim strMessage As String
0034Dim z As Integer
0035Dim Check_Text As String
0036Dim Check_404 As Boolean
0037Dim Start_Time As Double
0038Dim TagNames(100) As String
0039Dim iTags As Integer
0040'Note: this Sub checks all recorded URLs in my website against the Web, and records the results
0041'Adjust the parameters below if needs-be ...
0042Recent_Check_Days = 10
0043Recent_Check_Date = Now() - Recent_Check_Days
0044Recent_Check = Now() - Recent_Check_Days 'Parameter - Check gap in days
0045RunTime = 5 'Parameter - run time in hours
0046sBounce = 5 'IE Bounce time in minutes
0047max_Checks = 20 'In seconds I tried 5 minutes, but most previous time-outs seemed OK after 10 seconds
0048Option_Help = "Parameters are:- " & Chr$(10) & "... Check after " & Recent_Check_Days & " days"
0049Option_Help = Option_Help & Chr$(10) & "... Max run-time = " & RunTime & " hours"
0050Option_Help = Option_Help & Chr$(10) & "... Bounce IE after " & sBounce & " minutes"
0051Option_Help = Option_Help & Chr$(10) & "... Max checks = " & max_Checks
0052Option_Help = Option_Help & Chr$(10) & "Choose an Option:-"
0053Option_Help = Option_Help & Chr$(10) & "1. Run Full Check"
0054Option_Help = Option_Help & Chr$(10) & "2. Run Check for New Links since last run"
0055Option_Help = Option_Help & Chr$(10) & "3. Run for Time-outs when last checked"
0056Webrefs_Option = InputBox(Option_Help, "Enter an integer Spider Option", 1)
0057If Len(Webrefs_Option) = 0 Then
0058 End
0059End If
0060If Webrefs_Option < "1" Or Webrefs_Option > "3" Then
0061 MsgBox ("Choose an Option between 1 and 3")
0062 End
0063End If
0064Select Case Webrefs_Option
0065 Case 1
0066 strQuery = "SELECT * FROM Webrefs_Table WHERE (((Webrefs_Table.[Defunct?]) = False) And (([Date_Last_Checked] + 0) < " & Recent_Check_Date & ") And ((Webrefs_Table.Issue) <> ""Manual Check OK"")) Or (((Webrefs_Table.[Defunct?]) = False) And (([Date_Last_Checked] + 0) < " & Recent_Check_Date & ") And ((Webrefs_Table.Issue) Is Null)) ORDER BY Webrefs_Table.ID;"
0067 Case 2
0068 strQuery = "SELECT * FROM Webrefs_Table WHERE (((Webrefs_Table.[Defunct?]) = False) And (([Date_Last_Checked] & """") = """")) ORDER BY Webrefs_Table.ID;"
0069 Case 3
0070 strQuery = "SELECT * FROM Webrefs_Table WHERE (((Webrefs_Table.[Defunct?]) = False) And ((Webrefs_Table.Issue) = ""Timeout"")) ORDER BY Webrefs_Table.ID;"
0071 Recent_Check_Days = 0.5 / 24
0072 max_Checks = 60
0073 Recent_Check = Now() - Recent_Check_Days 'Parameter - Check gap in days - reset for Timeouts
0074 MsgBox ("Recent check parameter reset to half an hour & max checks to 60 - 1 minute - for Timeout-checker")
0075 Case Else
0076 End
0077End Select
0078Start_Time = Now()
0079Set rsTableControl = CurrentDb.OpenRecordset(strQuery)
0080If rsTableControl.EOF Then
0081 MsgBox "Nothing to do!"
0082 End
0083Else
0084 DoEvents
0085 rsTableControl.MoveLast
0086 DoEvents
0087End If
0088strMessage = "References yet to check = " & rsTableControl.RecordCount
0089Debug.Print Now() & " - "; strMessage
0090MsgBox (strMessage)
0091start = Now()
0092Debug.Print Now() & " - "; "Webrefs_Update Started"
0093Debug.Print Now() & " - "; "Webrefs_Update: " & strMessage
0094strMessage = "Last References to check = " & rsTableControl.Fields(0)
0095rsTableControl.MoveFirst
0096strMessage = "First References to check = " & rsTableControl.Fields(0) & "; " & strMessage
0097Debug.Print Now() & " - "; "Webrefs_Update: " & strMessage
0098'Open Internet Explorer in memory, and go to website
0099Set ie = New InternetExplorer
0100'ie.Visible = False
0101Last_Bounce = start
0102Returned_URL_Saved = "zzz"
0103Forced_Bounce = False
0104z = 1
0105Do While Not rsTableControl.EOF
0106 'Bounce IE every sBounce minutes
0107 If ((Now() - Last_Bounce) * 24 * 60 > sBounce) Or Forced_Bounce = True Then
0108 DoEvents
0109 ie.Quit
0110 Set ie = Nothing
0111 Set ie = New InternetExplorer
0112 'ie.Visible = False
0113 Last_Bounce = Now()
0114 If Forced_Bounce = True Then
0115 strMessage = "Forced Bounce: "
0116 Forced_Bounce = False
0117 Else
0118 strMessage = "Regular Bounce: "
0119 End If
0120 Debug.Print Now() & " - " & strMessage & "IE Bounced at " & Last_Bounce & " - Count = " & z & ". Id=" & rsTableControl.Fields(0)
0121 End If
0122 Uncheckable = False
0123 'Check if updated recently
0124 Recent_Check_OK = True
0125 If rsTableControl.Fields(4) > Recent_Check Then
0126 Recent_Check_OK = False
0127 End If
0128 Requested_URL = rsTableControl.Fields(1)
0129 If Right(Requested_URL, 4) = ".doc" Or Right(Requested_URL, 5) = ".docx" Or Right(Requested_URL, 4) = ".mp3" Or Right(Requested_URL, 4) = ".pps" Then 'Word or PowerPoint docs can't be saved automatically & mp3s loop ....
0130 Uncheckable = True
0131 Recent_Check_OK = False
0132 Issue = "File Type Uncheckable"
0133 End If
0134 Update_Time = Now()
0135 Given_Up = False
0136 If Recent_Check_OK = True Then
0137Resume_Here:
0138 Defunct = False
0139 Issue = ""
0140 On Error GoTo Err_Fix
0141 ie.Navigate Requested_URL
0142 Update_Time = Now()
0143 'Wait until IE is done loading page
0144 i = 1
0145 Returned_URL = ""
0146 If Err.Number <= 0 Then
0147 Do While ((ie.ReadyState < READYSTATE_COMPLETE) Or (Returned_URL = "")) And (Given_Up = False)
0148 DoEvents
0149 If ie.LocationURL & "" <> Returned_URL_Saved Then
0150 Returned_URL = ie.LocationURL
0151 End If
0152 i = i + 1
0153 If i > max_Checks Then
0154 Given_Up = True
0155 Issue = "Timeout"
0156 Forced_Bounce = True
0157 End If
0158 WaitFor (1) 'Wait 1 second, then check again
0159 If Err.Number > 0 Then
0160 GoTo Err_Fix
0161 End If
0162 Loop
0163 Else
0164 GoTo Err_Fix
0165 End If
0166 If Given_Up = False Then
0167 'Stick a test in here! This is mostly for future use ..
0168 For k = 1 To 100
0169 TagNames(i) = ""
0170 Next k
0171 iTags = 0
0172 On Error Resume Next 'Seems to work OK most of the time ... if it fails on the next line, "Object doesn't support this property or method" try terminating, compact & repair, and re-start. It's probably a recovery problem of some sort which I can't be bothered to resolve
0173 iTags = ie.Document.GetElementsByTagName("*").Length
0174 Err.Clear
0175 If InStr(Requested_URL, ".pdf") > 0 Then
0176 If iTags > 0 Then
0177 'If it really were a .pdf, iTags would be 0, so ...
0178 Issue = "PDF Not Found"
0179 End If
0180 End If
0181 If iTags > 100 Then
0182 iTags = 100
0183 End If
0184 If iTags > 0 Then
0185 'Debug.Print iTags
0186 For k = 1 To iTags
0187 TagNames(i) = ie.Document.GetElementsByTagName("*")(i).TagName
0188 'Debug.Print TagNames(i)
0189 Next k
0190 End If
0191 'Proceed ...
0192 Returned_URL = ""
0193 Returned_URL = ie.LocationURL
0194 If Requested_URL = Returned_URL Then
0195 If InStr(Requested_URL, ".pdf") = 0 Then
0196 On Error Resume Next 'Didn't work ...
0197 Returned_URL = ie.Document.URL 'Some documents don't support this ... if so, comment out, step over, and uncomment ready for the next page
0198 Err.Clear
0199 On Error GoTo Err_Fix
0200 End If
0201 End If
0202 Returned_URL_Saved = Returned_URL
0203 If (Requested_URL <> Returned_URL) Then
0204 If (Replace(Returned_URL, "https", "http") = Requested_URL) And (Issue <> "PDF Not Found") Then
0205 Issue = "URL Secured"
0206 Else
0207 If ((Requested_URL & "/" = Returned_URL) Or (Requested_URL = Returned_URL & "/")) And (Issue <> "PDF Not Found") Then
0208 Issue = "URL with trailing slash"
0209 Else
0210 If InStr(Returned_URL, "http://www.webaddresshelp.bt.com") > 0 And (Issue <> "PDF Not Found") Then
0211 Issue = "URL Not found"
0212 Defunct = True
0213 Forced_Bounce = True
0214 Else
0215 If (Left(Returned_URL, Len("http://web.demo.barefruit.co.uk/")) = "http://web.demo.barefruit.co.uk/") And (Issue <> "PDF Not Found") Then
0216 Issue = "URL Not Found"
0217 Defunct = True
0218 Forced_Bounce = True
0219 Else
0220 If Right(Returned_URL, 4) <> ".pdf" Then
0221 On Error Resume Next 'Didn't work ...
0222 Check_Text = ""
0223 If ie.Document.GetElementsByTagName("title").Length > 0 Then
0224 Check_Text = ie.Document.GetElementsByTagName("title")(0).innerHtml
0225 End If
0226 If ie.Document.GetElementsByTagName("h1").Length > 0 Then
0227 Check_Text = Check_Text & ie.Document.GetElementsByTagName("h1")(0).innerHtml
0228 End If
0229 'Probably could add other elements above ... ?
0230 If InStr(Check_Text, "404") > 0 Then
0231 If Issue <> "PDF Not Found" Then
0232 Issue = "Page Not Found"
0233 End If
0234 Defunct = True
0235 Else
0236 If InStr(Check_Text, "403") > 0 Then
0237 Issue = "Access Denied"
0238 Defunct = True
0239 End If
0240 End If
0241 If Issue = "" Then
0242 Issue = "URL Differs"
0243 End If
0244 Err.Clear
0245 On Error GoTo Err_Fix
0246 Else
0247 Issue = "PDF Not Found"
0248 End If
0249 End If
0250 End If
0251 End If
0252 End If
0253 End If
0254 If Issue = "" Then
0255 'Check Aeon or Psyche "page not found" ...
0256 If (InStr(Requested_URL, "https://aeon.co/") > 0 And Len(Requested_URL) > Len("https://aeon.co/about/")) Or (InStr(Requested_URL, "https://psyche.co/") > 0 And Len(Requested_URL) > Len("https://psyche.co/about/")) Then
0257 Check_404 = False
0258 For j = 0 To ie.Document.GetElementsByTagName("p").Length - 1
0259 Check_Text = ie.Document.GetElementsByTagName("p")(j).innerHtml
0260 If InStr(Check_Text, "(404)") > 0 Then
0261 Check_404 = True
0262 j = 30
0263 End If
0264 Next j
0265 If Check_404 = True Then
0266 Issue = "Page Not Found"
0267 Defunct = True
0268 End If
0269 End If
0270 End If
0271 If Issue = "" Then
0272 'Check Wikipedia "page not found" ...
0273 If InStr(Requested_URL, "https://en.wikipedia.org/wiki/") > 0 Then
0274 Check_404 = False
0275 For j = 0 To ie.Document.GetElementsByTagName("BODY").Length - 1
0276 Check_Text = ie.Document.GetElementsByTagName("BODY")(j).innerHtml
0277 If InStr(Check_Text, "Wikipedia does not have an article with this exact name") > 0 Then
0278 Check_404 = True
0279 j = 30
0280 End If
0281 Next j
0282 If Check_404 = True Then
0283 Issue = "Page Not Found"
0284 Defunct = True
0285 End If
0286 End If
0287 End If
0288 If Issue = "" Then
0289 If Right(Returned_URL, 4) <> ".pdf" Then
0290 On Error Resume Next 'Didn't work ...
0291 Check_Text = ""
0292 If ie.Document.GetElementsByTagName("title").Length > 0 Then
0293 Check_Text = ie.Document.GetElementsByTagName("title")(0).innerHtml
0294 End If
0295 If InStr(Check_Text, "404") > 0 Then
0296 Issue = "Page Not Found"
0297 Defunct = True
0298 Else
0299 If ie.Document.GetElementsByTagName("h1").Length > 0 Then
0300 Check_Text = ie.Document.GetElementsByTagName("h1")(0).innerHtml
0301 End If
0302 If InStr(Check_Text, "404") > 0 Then
0303 Issue = "Page Not Found"
0304 Defunct = True
0305 End If
0306 End If
0307 Err.Clear
0308 On Error GoTo Err_Fix
0309 End If
0310 End If
0311 End If
0312 If Issue = "URL Differs" Then
0313 If InStr(Requested_URL, "youtube") > 0 Then
0314 'Check for YouTube time issues
0315 j = InStr(Requested_URL, "&t=")
0316 If j > 0 Then
0317 YouTube_Check_Sent = Left(Requested_URL, j - 1)
0318 Else
0319 YouTube_Check_Sent = Requested_URL
0320 End If
0321 j = InStr(Returned_URL, "&t=")
0322 If j > 0 Then
0323 YouTube_Check_Returned = Left(Requested_URL, j - 1)
0324 Else
0325 YouTube_Check_Returned = Requested_URL
0326 End If
0327 If YouTube_Check_Sent = YouTube_Check_Returned Then
0328 Issue = ""
0329 Else
0330 Forced_Bounce = True
0331 End If
0332 Else
0333 Forced_Bounce = True
0334 End If
0335 If InStr(Returned_URL, "res://ieframe.dll") > 0 Then
0336 Debug.Print Now() & " - Count = " & z & ". " & "Id=" & rsTableControl.Fields(0) & ". Returned_URL: "; Returned_URL
0337 Issue = "URL Not found"
0338 Returned_URL = ""
0339 End If
0340 End If
0341 If Issue = "URL Not Found" Then
0342 Defunct = True
0343 Issue_Check = Right(Requested_URL, 6)
0344 If (InStr(Issue_Check, ".htm") > 0) Or (InStr(Issue_Check, ".html") > 0) Or (InStr(Issue_Check, ".shtm") > 0) Or (Right(Issue_Check, 1) = "/") Then
0345 Issue = "Page Not Found"
0346 Else
0347 If InStr(Issue_Check, ".") > 0 Then
0348 Issue = "Document Not Found"
0349 Else
0350 Issue = "Page Not Found"
0351 End If
0352 End If
0353 End If
0354 rsTableControl.Edit
0355 rsTableControl.Fields(4) = Now()
0356 If Issue = "URL Differs" Then
0357 rsTableControl.Fields(5) = Left(Returned_URL, 255)
0358 Else
0359 rsTableControl.Fields(5) = ""
0360 End If
0361 rsTableControl.Fields(6) = Issue
0362 rsTableControl.Fields(7) = i
0363 Update_Time = (Now() - Update_Time) * 24 * 60 * 60
0364 rsTableControl.Fields(8) = Update_Time
0365 rsTableControl.Fields(9) = Defunct
0366 rsTableControl.Update
0367 If Issue <> "" Then
0368 Debug_Print = " Issue = " & Issue
0369 Else
0370 Debug_Print = ""
0371 End If
0372 Debug_Print = Now() & " - Count = " & z & "." & Debug_Print & " Id=" & rsTableControl.Fields(0) & ", Tries = " & i & " Requested_URL = " & Requested_URL
0373 z = z + 1
0374 If Issue = "URL Differs" Then
0375 Debug_Print = Debug_Print & " Returned_URL = " & Returned_URL
0376 End If
0377 If Issue <> "" Then
0378 Debug.Print Debug_Print
0379 End If
0380 End If
0381 rsTableControl.MoveNext
0382 Running_Hours = (Now() - start) * 24
0383 If Running_Hours > RunTime Then
0384 Stop
0385 start = Now()
0386 End If
0387Loop
0388ie.Quit
0389Set ie = Nothing
0390Start_Time = Round((Now() - Start_Time) * 24 * 60, 1)
0391 Debug_Print = Now() & " - Webrefs_Update Completed in " & Start_Time & " minutes."
0392Debug.Print Debug_Print
0393MsgBox "Webrefs Checker Completed at " & Now() & " in " & Start_Time & " minutes."
0394Exit Sub
0395Err_Fix:
0396Debug.Print Now() & " - Id=" & rsTableControl.Fields(0) & " " & Err.Description
0397DoEvents
0398Err.Clear
0399Set ie = Nothing
0400Set ie = New InternetExplorer
0401'ie.Visible = False
0402Last_Bounce = Now()
0403Forced_Bounce = False
0404Debug.Print Now() & " - "; "Error Bounce: IE Bounced at " & Last_Bounce
0405GoTo Resume_Here
0406End Sub

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


© Theo Todman, June 2007 - July 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