Line-No. / Ref. | Code Line |
0001 | Public Sub Auto_Reference_Notes_Regen(Optional Auto) |
0002 | Dim rs As Recordset |
0003 | Dim strQuery As String |
0004 | Dim Duration As Single |
0005 | Dim RunStartTime As Date |
0006 | Dim iUpdates_Total As Integer |
0007 | Dim Estimated_Run_Time As Single |
0008 | Dim Update_Start As Double |
0009 | Dim Auto_Local As Boolean |
0010 | If IsMissing(Auto) Then |
0011 | Auto_Local = False |
0012 | Else |
0013 | Auto_Local = IIf(Auto = "Yes", True, False) |
0014 | End If |
0015 | iUpdates_Total = 0 |
0016 | Estimated_Run_Time = 0 |
0017 | strQuery = "SELECT Note_Alternates.ID, Note_Alternates.[Auto_Link?], Note_Alternates.Item_Alt_Title, Note_Alternates.Item_Title, Note_Alternates.Last_Auto_Link_Run, Note_Alternates.Regen_Time FROM Note_Alternates WHERE (((Note_Alternates.Item_Alt_Title) = [Item_Title]) And ((Note_Alternates.Last_Auto_Link_Run) Is Not Null)) ORDER BY Note_Alternates.ID;" |
0018 | Set rs = CurrentDb.OpenRecordset(strQuery) |
0019 | rs.MoveFirst |
0020 | Do While Not rs.EOF |
0021 | iUpdates_Total = iUpdates_Total + 1 |
0022 | Estimated_Run_Time = Estimated_Run_Time + Nz(rs.Fields(5)) |
0023 | If rs.Fields(1) = True Then |
0024 | rs.Edit |
0025 | rs.Fields(1) = False |
0026 | rs.Update |
0027 | End If |
0028 | rs.MoveNext |
0029 | Loop |
0030 | If automatic_processing <> "Yes" Then |
0031 | If MsgBox(iUpdates_Total & " files to update; estimated time = " & Round(Estimated_Run_Time, 1) & " minutes. Continue?", vbYesNo) <> vbYes Then |
0032 | End |
0033 | End If |
0034 | End If |
0035 | automatic_processing = "Yes" |
0036 | 'Now regenerate |
0037 | RunStartTime = Now() |
0038 | rs.MoveFirst |
0039 | Do While Not rs.EOF |
0040 | rs.Edit |
0041 | rs.Fields(1) = True |
0042 | rs.Update |
0043 | Update_Start = Now() |
0044 | Auto_Reference_Notes (Auto_Local) |
0045 | rs.Edit |
0046 | rs.Fields(1) = False |
0047 | rs.Fields(5) = 24 * 60 * (Now() - Update_Start) |
0048 | rs.Update |
0049 | rs.MoveNext |
0050 | Loop |
0051 | Set rs = CurrentDb.OpenRecordset("SELECT * FROM BookPaperControl WHERE ID = ""Auto_Reference_Notes_Regen"";") |
0052 | Duration = Round((Now() - RunStartTime) * 24 * 60, 1) |
0053 | rs.Edit |
0054 | rs.Fields(1) = Now() |
0055 | rs.Fields(2) = Duration |
0056 | rs.Update |
0057 | If Auto_Local = False Then |
0058 | MsgBox "Automatic Note Linkages Regen Completed in " & Duration & " minutes. " & iUpdates_Total & " pages output.", vbOKOnly, "Automatic Note Linkages" |
0059 | End If |
0060 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Function Mark_Colours(strText) |
0002 | Dim x As Long |
0003 | Dim Y As Long |
0004 | Dim ColourRef As String |
0005 | Dim strText_Local As String |
0006 | Dim strText_Start As String |
0007 | Dim strText_Middle As String |
0008 | Dim strText_End As String |
0009 | Dim qryString As String |
0010 | Dim rsTableToRead As Recordset |
0011 | Dim i As Integer |
0012 | If Len(strText) = 0 Then |
0013 | Mark_Colours = "Not Found" |
0014 | Exit Function |
0015 | End If |
0016 | i = 0 |
0017 | strText_Local = strText |
0018 | x = 1 |
0019 | x = InStr(x, UCase(strText_Local), "|COLOUR_") |
0020 | Mark_Colours = "Not Found" |
0021 | Do While x > 0 |
0022 | strText_Start = Left(strText_Local, x - 1) |
0023 | Mark_Colours = "Found" |
0024 | Y = InStr(x + 1, strText_Local, "|") |
0025 | ColourRef = Mid(strText_Local, x + 8, Y - x - 8) |
0026 | If Y > Len(strText_Local) - 2 Then |
0027 | strText_End = "" |
0028 | Else |
0029 | strText_End = Mid(strText_Local, Y + 1, Len(strText_Local)) |
0030 | End If |
0031 | If ColourRef = "R" Then |
0032 | strText_Middle = "" |
0033 | Else |
0034 | 'Determine Colour Title |
0035 | If Val(ColourRef) >= 0 And ColourRef < 20 Then |
0036 | 'Colour_Table |
0037 | If Colour_Table(0, 0) & "" = "" Then |
0038 | For i = 0 To 19 'Clear the Saved Array |
0039 | Colour_Table(i, 0) = "" |
0040 | Colour_Table(i, 1) = "" |
0041 | Colour_Table(i, 2) = "" |
0042 | Colour_Table(i, 3) = "" |
0043 | Colour_Table(i, 4) = "0" |
0044 | Next i |
0045 | 'Populate Colour_Table |
0046 | Colour_Table(0, 0) = "0" |
0047 | Colour_Table(0, 1) = "000000" |
0048 | Colour_Table(0, 2) = "Black" |
0049 | Colour_Table(0, 3) = "Printable Text by me; © Theo Todman, " & Year(Now()) |
0050 | Colour_Table(0, 4) = "0" |
0051 | qryString = "SELECT Colours.* FROM Colours;" |
0052 | Set rsTableToRead = CurrentDb.OpenRecordset(qryString) |
0053 | If Not rsTableToRead.EOF Then |
0054 | rsTableToRead.MoveFirst |
0055 | Do While Not rsTableToRead.EOF |
0056 | Colour_Table(rsTableToRead.Fields(0), 0) = rsTableToRead.Fields(0) |
0057 | Colour_Table(rsTableToRead.Fields(0), 1) = rsTableToRead.Fields(1) |
0058 | Colour_Table(rsTableToRead.Fields(0), 2) = rsTableToRead.Fields(2) |
0059 | Colour_Table(rsTableToRead.Fields(0), 3) = Replace(rsTableToRead.Fields(3), "YYYY", Year(Now())) |
0060 | Colour_Table(rsTableToRead.Fields(0), 4) = "0" |
0061 | rsTableToRead.MoveNext |
0062 | Loop |
0063 | End If |
0064 | Set rsTableToRead = Nothing |
0065 | End If |
0066 | strText_Middle = "" |
0067 | 'Flag colour used |
0068 | Colour_Table(Val(ColourRef), 4) = 1 |
0069 | Else |
0070 | strText_Middle = "" |
0071 | MsgBox ("Unknown colour ID = """ & ColourRef & """") |
0072 | Stop |
0073 | End If |
0074 | End If |
0075 | strText_Local = strText_Start & strText_Middle & strText_End |
0076 | x = InStr(x, strText_Local, "|Colour_") |
0077 | Loop |
0078 | strText = strText_Local |
0079 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Function Reference_Author(strText, Calling_Type, Calling_ID, Calling_Timestamp, Optional Depth) |
0002 | Dim x As Long |
0003 | Dim Y As Long |
0004 | Dim AuthorRef As String |
0005 | Dim strText_Local As String |
0006 | Dim strText_End As String |
0007 | Dim qryString As String |
0008 | Dim rsTableToRead As Recordset |
0009 | Dim AuthorLink As String |
0010 | Dim AuthorDirectory As String |
0011 | Dim strName As String |
0012 | Dim iDepth As Integer |
0013 | Dim strPrefix As String |
0014 | Dim i As Integer |
0015 | Dim Calling_ID_Local As Integer |
0016 | Dim Author_ID As Integer |
0017 | Dim AuthorDisplay As String |
0018 | Dim Author_Comma As Boolean |
0019 | Dim Author_Reformat As String |
0020 | Dim j As Integer |
0021 | Dim k As Integer |
0022 | If Len(strText) = 0 Then |
0023 | Reference_Author = "Not Found" |
0024 | Exit Function |
0025 | End If |
0026 | If IsMissing(Depth) Then |
0027 | iDepth = 2 |
0028 | Else |
0029 | iDepth = Depth |
0030 | End If |
0031 | i = 0 |
0032 | strPrefix = "" |
0033 | Do While i < iDepth |
0034 | strPrefix = strPrefix & "../" |
0035 | i = i + 1 |
0036 | Loop |
0037 | strText_Local = strText |
0038 | x = 1 |
0039 | x = InStr(x, strText_Local, "+A") |
0040 | Reference_Author = "Not Found" |
0041 | If Not IsNumeric(Calling_ID) Then |
0042 | qryString = "SELECT Authors.Author_ID FROM Authors WHERE Authors.Author_Name=""" & Calling_ID & """;" |
0043 | Set rsTableToRead = CurrentDb.OpenRecordset(qryString) |
0044 | If Not rsTableToRead.EOF Then |
0045 | Calling_ID_Local = rsTableToRead.Fields(0) |
0046 | Else |
0047 | Calling_ID_Local = 0 |
0048 | End If |
0049 | Else |
0050 | Calling_ID_Local = Calling_ID |
0051 | End If |
0052 | Do While x > 0 |
0053 | Reference_Author = "Found" |
0054 | Y = InStr(x + 1, strText_Local, "A+") |
0055 | 'Watch out for false positives in finding +A |
0056 | If Y = 0 Then |
0057 | x = x + 1 |
0058 | Else |
0059 | If Y - x > 50 Then |
0060 | x = x + 1 |
0061 | Else |
0062 | AuthorRef = Mid(strText_Local, x + 2, Y - x - 2) & "" |
0063 | If AuthorRef = "" Then |
0064 | x = x + 1 |
0065 | Else |
0066 | If Left(AuthorRef, 1) = "," Then |
0067 | AuthorRef = Mid(AuthorRef, 2) |
0068 | Author_Comma = True |
0069 | Else |
0070 | Author_Comma = False |
0071 | End If |
0072 | If Y > Len(strText_Local) - 2 Then |
0073 | strText_End = "" |
0074 | Else |
0075 | strText_End = Mid(strText_Local, Y + 2, Len(strText_Local)) |
0076 | End If |
0077 | If Calling_Type <> "X" Then |
0078 | qryString = "SELECT Authors.Author_ID FROM Authors WHERE Authors.Author_Name=""" & AuthorRef & """;" |
0079 | Set rsTableToRead = CurrentDb.OpenRecordset(qryString) |
0080 | If Not rsTableToRead.EOF Then |
0081 | Author_ID = rsTableToRead.Fields(0) |
0082 | Else |
0083 | Author_ID = 0 |
0084 | End If |
0085 | OK = Cross_Reference_Add(Calling_Type, Calling_ID_Local, Calling_Timestamp, "A", Author_ID, 0) |
0086 | End If |
0087 | 'Determine Author(s) & Add link |
0088 | AuthorLink = "" |
0089 | qryString = "SELECT Authors.Author_Name, Authors.Author_Name_Display FROM Authors WHERE (((Authors.Author_Name) = """ & AuthorRef & """)) Or (((Authors.Author_Name) Like """ & AuthorRef & " *"")) ORDER BY Authors.Author_Name;" |
0090 | Set rsTableToRead = CurrentDb.OpenRecordset(qryString) |
0091 | If Not rsTableToRead.EOF Then |
0092 | rsTableToRead.MoveFirst |
0093 | AuthorDirectory = Left(AuthorRef, 1) |
0094 | AuthorLink = rsTableToRead.Fields(0).Value |
0095 | If Author_Comma = True Then |
0096 | AuthorDisplay = Replace(AuthorLink, " (", ", ") |
0097 | AuthorDisplay = Replace(AuthorDisplay, ")", "") |
0098 | Else |
0099 | AuthorDisplay = rsTableToRead.Fields(1).Value & "" |
0100 | If AuthorDisplay = "" Then |
0101 | AuthorDisplay = AuthorRef |
0102 | End If |
0103 | End If |
0104 | AuthorLink = "" & AuthorDisplay & "" |
0105 | If Calling_Type <> "X" Then |
0106 | strName = "" |
0107 | AuthorLink = strName & AuthorLink |
0108 | End If |
0109 | strText_Local = Left(strText_Local, x - 1) & AuthorLink & strText_End |
0110 | Else |
0111 | AuthorLink = """Unknown Author""" |
0112 | Author_Reformat = AuthorRef |
0113 | j = InStr(Author_Reformat, "(") |
0114 | If j > 0 Then |
0115 | k = InStr(j, Author_Reformat, ")") |
0116 | If k > 0 Then |
0117 | Author_Reformat = Mid(Author_Reformat, j + 1, k - j - 1) & " " & Trim(Left(Author_Reformat, j - 1)) |
0118 | End If |
0119 | End If |
0120 | strText_Local = Left(strText_Local, x - 1) & Author_Reformat & strText_End |
0121 | End If |
0122 | Set rsTableToRead = Nothing |
0123 | End If |
0124 | End If |
0125 | End If |
0126 | x = InStr(x, strText_Local, "+A") |
0127 | Loop |
0128 | strText = strText_Local |
0129 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Function Reference_Code(strText, Optional Depth, Optional NoText) |
0002 | Dim x As Long |
0003 | Dim Y As Long |
0004 | Dim strCodeRef As String |
0005 | Dim CodeRef As String |
0006 | Dim strText_Local As String |
0007 | Dim strText_End As String |
0008 | Dim qryString As String |
0009 | Dim rsTableToRead As Recordset |
0010 | Dim CodeLocation As String |
0011 | Dim iDepth As Integer |
0012 | Dim strPrefix As String |
0013 | Dim i As Integer |
0014 | If Len(strText) = 0 Then |
0015 | Reference_Code = "Not Found" |
0016 | Exit Function |
0017 | End If |
0018 | If IsMissing(Depth) Then |
0019 | iDepth = 2 |
0020 | Else |
0021 | iDepth = Depth |
0022 | End If |
0023 | i = 0 |
0024 | strPrefix = "" |
0025 | Do While i < iDepth |
0026 | strPrefix = strPrefix & "../" |
0027 | i = i + 1 |
0028 | Loop |
0029 | strText_Local = strText |
0030 | x = 1 |
0031 | x = InStr(x, strText_Local, "+C") |
0032 | Reference_Code = "Not Found" |
0033 | Do While x > 0 |
0034 | Reference_Code = "Found" |
0035 | Y = InStr(x + 1, strText_Local, "C+") |
0036 | 'Watch out for false positives in finding +C |
0037 | If Y = 0 Then |
0038 | x = x + 1 |
0039 | Else |
0040 | If Y - x > 100 Then |
0041 | x = x + 1 |
0042 | Else |
0043 | strCodeRef = Mid(strText_Local, x + 2, Y - x - 2) |
0044 | CodeRef = Trim(strCodeRef) |
0045 | If Y > Len(strText_Local) - 2 Then |
0046 | strText_End = "" |
0047 | Else |
0048 | strText_End = Mid(strText_Local, Y + 2, Len(strText_Local)) |
0049 | End If |
0050 | 'Determine Code Location |
0051 | CodeLocation = "" |
0052 | qryString = "SELECT Code_Table.Procedure_Name, Code_Table.Code_Location FROM Code_Table WHERE (((Code_Table.Procedure_Name)=""" & CodeRef & """));" |
0053 | Set rsTableToRead = CurrentDb.OpenRecordset(qryString) |
0054 | If Not rsTableToRead.EOF Then |
0055 | rsTableToRead.MoveFirst |
0056 | CodeLocation = rsTableToRead.Fields(1).Value |
0057 | strCodeRef = CodeRef |
0058 | If Not IsMissing(NoText) Then |
0059 | strCodeRef = "Code" |
0060 | End If |
0061 | strText_Local = Left(strText_Local, x - 1) & "" & strCodeRef & "" & strText_End |
0062 | Else |
0063 | 'strText_Local = Left(strText_Local, x - 1) & CodeRef & strText_End 'This removed the +CC+ wrapper, and so made Reference_Code_Bridge fail to refer! |
0064 | x = x + 2 |
0065 | End If |
0066 | Set rsTableToRead = Nothing |
0067 | End If |
0068 | End If |
0069 | x = InStr(x, strText_Local, "+C") |
0070 | Loop |
0071 | strText = strText_Local |
0072 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Sub Spider_Copy() |
0002 | Dim iOld_Errors As Long |
0003 | Dim iNew_Errors As Long |
0004 | Dim rs As Recordset |
0005 | Dim strQuery As String |
0006 | Dim strMessage As String |
0007 | 'Copy the Temp files to the Slave Database |
0008 | OK = Check_Database_Size() |
0009 | strMessage = Now() & " - Spider_Copy: Entering Spider_Copy" |
0010 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0011 | Debug.Print strMessage |
0012 | Set rsSpider_Temp_Links = Nothing |
0013 | Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance") |
0014 | OK = Check_Database_Size() |
0015 | strMessage = Now() & " - Spider_Copy: Web_Generator_Performance initial C/R complete" |
0016 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0017 | Debug.Print strMessage |
0018 | DoCmd.SetWarnings (False) |
0019 | DoCmd.RunSQL ("INSERT INTO Raw_Links_Temp ( Directory, File_Name, Raw_Link, Link_Count, Timestamp_Logged ) SELECT Raw_Links_Temp_Temp.Directory, Raw_Links_Temp_Temp.File_Name, Raw_Links_Temp_Temp.Raw_Link, Count(Raw_Links_Temp_Temp.Raw_Link) AS CountOfRaw_Link, Now() AS Expr1 FROM Raw_Links_Temp_Temp GROUP BY Raw_Links_Temp_Temp.Directory, Raw_Links_Temp_Temp.File_Name, Raw_Links_Temp_Temp.Raw_Link, Now();") |
0020 | DoCmd.RunSQL ("DELETE * FROM Raw_Links_Temp_Temp;") |
0021 | Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance") |
0022 | DoCmd.RunSQL ("UPDATE Raw_Links_Temp SET Raw_Links_Temp.Link_Type = Link_Type([Raw_Links_Temp]![Raw_Link]);") |
0023 | OK = Check_Database_Size() |
0024 | strMessage = Now() & " - Spider_Copy: Raw_Links_Temp Created" |
0025 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0026 | Debug.Print strMessage |
0027 | 'Update & Tidy Up any no-longer-existent items in Directory_Structure, ... |
0028 | DoCmd.OpenQuery ("Directory_Structure_Prune") 'Note: Directory_Structure_Prune might be invalid as it stands - sub-directories of "do not parse" directories could be deleted - need to check. |
0029 | DoCmd.OpenQuery ("Directory_Structure_Add") |
0030 | DoCmd.OpenQuery ("Directory_Structure_Updt") |
0031 | DoCmd.RunSQL ("DELETE Directory_Structure_Temp.* FROM Directory_Structure_Temp;") |
0032 | strQuery = "INSERT INTO Directory_Structure_Temp ( Directory, Directory_Short, Directory_Level, Timestamp_Logged, Do_Not_Parse, Updates_Only ) SELECT [Directory] & ""\"" AS Expr1, Directory_Structure.Directory_Short, Directory_Structure.Directory_Level, Directory_Structure.Timestamp_Logged, Directory_Structure.Do_Not_Parse, Directory_Structure.Updates_Only FROM Directory_Structure;" |
0033 | DoCmd.RunSQL (strQuery) |
0034 | OK = Check_Database_Size() |
0035 | strMessage = Now() & " - Spider_Copy: Directory_Structure_Temp Created" |
0036 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0037 | Debug.Print strMessage |
0038 | '... Site_Map, ... |
0039 | DoCmd.OpenQuery ("Site_Map_Add") |
0040 | DoCmd.OpenQuery ("Site_Map_Updt") |
0041 | '... the following query may be invalid if |
0042 | strQuery = "DELETE Site_Map.*, Directory_Structure_Temp.Directory FROM Site_Map LEFT JOIN Directory_Structure_Temp ON Site_Map.Directory = Directory_Structure_Temp.Directory WHERE (((Directory_Structure_Temp.Directory) Is Null));" |
0043 | DoCmd.RunSQL (strQuery) |
0044 | OK = Check_Database_Size() |
0045 | strMessage = Now() & " - Spider_Copy: Site_Map Updated" |
0046 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0047 | Debug.Print strMessage |
0048 | '... and Raw_Links |
0049 | DoCmd.OpenQuery ("Raw_Links_Zap") 'Delete for processed Site_Map Files |
0050 | 'Need to compact and repair here ... slave database will be virtually empty after this |
0051 | Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance") |
0052 | OK = Check_Database_Size() |
0053 | strMessage = Now() & " - Spider_Copy: Raw_Links Update Started" |
0054 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0055 | Debug.Print strMessage |
0056 | DoCmd.OpenQuery ("Raw_Links_Add") 'Adds them back, and any new ones, and does the updates |
0057 | DoCmd.OpenQuery ("Raw_Links_Updt") 'Probably not required! |
0058 | 'Need to delete Raw_Links associateed with Site_Map Files that no longer exist |
0059 | DoCmd.RunSQL ("DELETE Raw_Links_Temp.* FROM Raw_Links_Temp;") |
0060 | DoCmd.OpenQuery ("Raw_Links_Zapper_GEN") 'Add Raw Links to be deleted to Raw_Links_Temp |
0061 | strQuery = "DELETE Raw_Links.* FROM Raw_Links INNER JOIN Raw_Links_Temp ON (Raw_Links.Raw_Link = Raw_Links_Temp.Raw_Link) AND (Raw_Links.File_Name = Raw_Links_Temp.File_Name) AND (Raw_Links.Directory = Raw_Links_Temp.Directory);" |
0062 | DoCmd.RunSQL (strQuery) |
0063 | OK = Check_Database_Size() |
0064 | strMessage = Now() & " - Spider_Copy: Raw_Links Update Completed" |
0065 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0066 | Debug.Print strMessage |
0067 | 'Tidy up Temp tables |
0068 | DoCmd.RunSQL ("DELETE Directory_Structure_Temp.* FROM Directory_Structure_Temp;") |
0069 | DoCmd.RunSQL ("DELETE Site_Map_Temp.* FROM Site_Map_Temp;") |
0070 | DoCmd.RunSQL ("DELETE Raw_Links_Temp.* FROM Raw_Links_Temp;") |
0071 | Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance") |
0072 | 'Maintain Directory_Fine_Structure |
0073 | Directory_Fine_Structure_Gen |
0074 | OK = Check_Database_Size() |
0075 | strMessage = Now() & " - Spider_Copy: Directory_Fine_Structure_Gen Complete" |
0076 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0077 | Debug.Print strMessage |
0078 | 'Determine the full links - Note - if this is run for a complete refresh, the slave database will exceed the 2Gb limit |
0079 | ' ... and will need to be Compacted&Repaired - currently every 200k records |
0080 | OK = Check_Database_Size() |
0081 | strMessage = Now() & " - Spider_Copy: Full_Link_Same_Directory_Gen Commenced" |
0082 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0083 | Debug.Print strMessage |
0084 | Full_Link_Same_Directory_Gen |
0085 | OK = Check_Database_Size() |
0086 | strMessage = Now() & " - Spider_Copy: Full_Link_Same_Directory_Gen Completed" |
0087 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0088 | Debug.Print strMessage |
0089 | Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance") |
0090 | Debug.Print Now() & " - Spider_Copy: Full_Link_Up_Levels_Gen Started" |
0091 | Full_Link_Up_Levels_Gen |
0092 | OK = Check_Database_Size() |
0093 | strMessage = Now() & " - Spider_Copy: Full_Link_Up_Levels_Gen Complete" |
0094 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0095 | Debug.Print strMessage |
0096 | Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance") |
0097 | Full_Link_Sections_Fix |
0098 | OK = Check_Database_Size() |
0099 | strMessage = Now() & " - Spider_Copy: Full_Link_Sections_Fix Complete" |
0100 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0101 | Debug.Print strMessage |
0102 | Compact_Repair ("C:\Theo's Files\Birkbeck\Web_Generator_Performance") |
0103 | 'Update the "missing links" table |
0104 | DoCmd.OpenQuery ("Raw_Broken_Links_Old_Zap") |
0105 | DoCmd.OpenQuery ("Raw_Broken_Links_Old_Updt") 'Save a copy of the broken links table |
0106 | DoCmd.OpenQuery ("Raw_Broken_Links_Old_Counts_Detail") 'Display an error summary |
0107 | DoCmd.OpenQuery ("Raw_Broken_Links_Zap") |
0108 | DoCmd.OpenQuery ("Spider_Missing_Internal_Links_Add") 'Add broken links to Raw_Broken_Links table |
0109 | DoCmd.OpenQuery ("Raw_Broken_Links_Error_Reference_Copy") 'Copy Error_References from Raw_Broken_Links_Old table to Raw_Broken_Links table |
0110 | DoCmd.OpenQuery ("Raw_Links_Error_References_Clear") 'Clear Error_References in Raw_Links table in case they've been fixed |
0111 | DoCmd.OpenQuery ("Raw_Links_Error_References_Updt") 'Copy unfixed Error_References from Raw_Broken_Links back to Raw_Links |
0112 | DoCmd.OpenQuery ("Raw_Broken_Links_Detail_List") 'Display an error list |
0113 | DoCmd.OpenQuery ("Raw_Broken_Links_Counts_Detail") 'Display an error summary |
0114 | DoCmd.OpenQuery ("Raw_Broken_Links_Fixed_Counts") 'Display a summary of fixed errors |
0115 | Set rs = CurrentDb.OpenRecordset("Raw_Broken_Links_Counts") |
0116 | If Not rs.EOF Then |
0117 | rs.MoveFirst |
0118 | If rs.Fields(0).Value = "1. Old" Then |
0119 | iOld_Errors = rs.Fields(1).Value |
0120 | Else |
0121 | iOld_Errors = 0 |
0122 | End If |
0123 | DoEvents |
0124 | rs.MoveLast |
0125 | If rs.Fields(0).Value = "2. New" Then |
0126 | iNew_Errors = rs.Fields(1).Value |
0127 | Else |
0128 | iNew_Errors = 0 |
0129 | End If |
0130 | DoEvents |
0131 | End If |
0132 | Set rs = Nothing |
0133 | OK = Check_Database_Size() |
0134 | strMessage = Now() & " - Spider_Copy: New Broken Links = " & iNew_Errors & "; Old Broken Links Carried Forward = " & iOld_Errors |
0135 | strMessage = strMessage & " (Main Database size = " & Check_Database_Size & "Mb)" |
0136 | Debug.Print strMessage |
0137 | DoCmd.SetWarnings (True) |
0138 | End Sub |