Line-No. / Ref. | Code Line |
0001 | Public Function CopyReplace_TextStream(InFile, OutFile, NoteSubDirectory) |
0002 | 'This is a new module to read the html files and update the Notes directories |
0003 | 'It was based on http://www.tutorial-web.com/asp/fso/textstream |
0004 | Dim fso As FileSystemObject |
0005 | Dim tsTextFileIn As TextStream |
0006 | Dim tsTextFileOut As TextStream |
0007 | Dim strLine As String |
0008 | Dim MainFolder |
0009 | Dim FileCollection |
0010 | Dim File |
0011 | Set fso = CreateObject("Scripting.FileSystemObject") |
0012 | Set tsTextFileIn = fso.OpenTextFile(InFile, 1, False, 0) |
0013 | If Dir(OutFile) <> "" Then 'If we already have a file in the transfer directory, then zap it |
0014 | Kill OutFile |
0015 | End If |
0016 | Set tsTextFileOut = fso.CreateTextFile(OutFile, True, True) |
0017 | Do Until tsTextFileIn.AtEndOfStream |
0018 | strLine = tsTextFileIn.ReadLine |
0019 | 'Translate the line for Notes Links |
0020 | strLine = ReplaceNoteLink(strLine, "Notes_", "Notes_Print") |
0021 | 'Translate the line for Books Links (add an extra ../) |
0022 | strLine = ReplaceLink(strLine, "../BookSummaries", "../") |
0023 | 'Translate the line for Papers Links (add an extra ../) |
0024 | strLine = ReplaceLink(strLine, "../PaperSummaries", "../") |
0025 | tsTextFileOut.WriteLine strLine |
0026 | Loop |
0027 | End Function |
Line-No. / Ref. | Code Line |
0001 | Public Sub CreateBookCitingsWebPages(Automatic) |
0002 | 'This is a new module to generate the pages that list the Books and Papers that (via my Abstract / Comments) cite a particular Book. |
0003 | 'It was based on Sub CreateAuthorsWebPages |
0004 | 'Called by WebpageBookCitings |
0005 | Dim fsoTextFile As FileSystemObject |
0006 | Dim tsTextFile As TextStream |
0007 | Dim rsTableToRead As Recordset |
0008 | Dim rsBooks As Recordset |
0009 | Dim rsTableControl As Recordset |
0010 | Dim strControlQuery As String |
0011 | Dim strLine As String |
0012 | Dim iTableColumns As Integer |
0013 | Dim iFieldNo As Integer |
0014 | Dim x As Integer |
0015 | Dim strQry As String |
0016 | Dim i As Integer |
0017 | Dim Book_ID As Integer |
0018 | Dim Book_ID_Previous As Integer |
0019 | Dim ObjectID As Integer |
0020 | Dim strFileSuffix As String |
0021 | Dim strFileBody As String |
0022 | Dim StartTime As Double |
0023 | Dim Time_Stamp As String |
0024 | Dim strAuthors As String |
0025 | Dim iCount As Long |
0026 | iCount = 0 |
0027 | Dim Saved_Link_Type As String |
0028 | Dim Saved_ObjectID As Integer |
0029 | Dim DoneEnough As Boolean |
0030 | Dim StrComma As String |
0031 | Dim iExtras As Integer |
0032 | Set fsoTextFile = New FileSystemObject |
0033 | strFolder = strOutputFolder |
0034 | StartTime = Now() |
0035 | 'Read the data for Citations of this Book |
0036 | Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery) |
0037 | If Not rsTableToRead.EOF Then |
0038 | rsTableToRead.MoveFirst |
0039 | iTableColumns = rsTableToRead.Fields.Count |
0040 | 'Column 0 is the Book ID, anti-Penultimate Column is the Object ID, the Penultimate Column says whether it's a Book or a Paper; the last column is the position on the page |
0041 | Book_ID_Previous = 0 'There is no Book_ID 0 |
0042 | strFileSuffix = "" |
0043 | strFileBody = "" |
0044 | Do Until rsTableToRead.EOF |
0045 | Book_ID = rsTableToRead.Fields(0) |
0046 | ObjectID = rsTableToRead.Fields(iTableColumns - 3) |
0047 | If Book_ID_Previous <> Book_ID Then 'New Book |
0048 | 'Read the Book Author & Title |
0049 | strQry = "Select Books.Title, Books.Author from Books Where Books.ID1 = " & Book_ID & ";" |
0050 | Set rsBooks = CurrentDb.OpenRecordset(strQry) |
0051 | rsBooks.MoveFirst |
0052 | 'Write the previous Footer (except first time) |
0053 | If Book_ID_Previous <> 0 Then |
0054 | 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;" |
0055 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0056 | rsTableControl.MoveFirst |
0057 | Do While Not rsTableControl.EOF |
0058 | Time_Stamp = rsTableControl.Fields(0) & "" |
0059 | OK = Replace_Timestamp(Time_Stamp) |
0060 | tsTextFile.WriteLine Time_Stamp |
0061 | rsTableControl.MoveNext |
0062 | Loop |
0063 | OK = CopyToTransfer(strFolder & strFileBody & "\", strFileSuffix & ".htm") |
0064 | iCount = iCount + 1 |
0065 | End If |
0066 | Book_ID_Previous = Book_ID |
0067 | strFileSuffix = strOutputFileShort & "_" & Book_ID |
0068 | strFileBody = "BookSummary_" & Mid(100000 + Book_ID, 2, 2) |
0069 | 'Create File |
0070 | Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFolder & strFileBody & "\" & strFileSuffix & ".htm", True, True) |
0071 | 'Page Header |
0072 | 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;" |
0073 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0074 | rsTableControl.MoveFirst |
0075 | Do While Not rsTableControl.EOF |
0076 | strLine = rsTableControl.Fields(0) & "" |
0077 | x = InStr(1, strLine, "**BOOK**") |
0078 | If x > 0 Then |
0079 | 'Add the Book Title |
0080 | strLine = Left(strLine, x - 1) & "" & rsBooks.Fields(0).Value & "" & Mid(strLine, x + 8, Len(strLine)) |
0081 | End If |
0082 | x = InStr(1, strLine, "**AUTHOR**") |
0083 | If x > 0 Then |
0084 | 'Add the Book Author |
0085 | strAuthors = rsBooks.Fields(1) |
0086 | OK = Author_Reference_String(strAuthors, 2) |
0087 | strLine = Left(strLine, x - 1) & strAuthors & Mid(strLine, x + 10, Len(strLine)) |
0088 | End If |
0089 | tsTextFile.WriteLine strLine |
0090 | rsTableControl.MoveNext |
0091 | Loop |
0092 | 'Read Table-Control for rows |
0093 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Table_Row"")) ORDER BY Website_Control.Line;" |
0094 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0095 | 'Table Column Headings |
0096 | rsTableControl.MoveFirst |
0097 | Do While Not rsTableControl.EOF |
0098 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0099 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0100 | 'Note: Fields start at 0, but the first one in the query is the Book ID, and the last two are the Object ID and the page-ref |
0101 | If iFieldNo > 0 And iFieldNo <= iTableColumns - 3 Then |
0102 | If iFieldNo = 6 Then |
0103 | tsTextFile.WriteLine " | Repeats ... | "
0104 | Else |
0105 | tsTextFile.WriteLine " " & rsTableToRead.Fields(iFieldNo).Name & "" |
0106 | End If |
0107 | End If |
0108 | Else |
0109 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0110 | End If |
0111 | rsTableControl.MoveNext |
0112 | Loop |
0113 | End If |
0114 | 'Table Row |
0115 | rsTableControl.MoveFirst |
0116 | Do While Not rsTableControl.EOF |
0117 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0118 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0119 | If iFieldNo > 0 And iFieldNo <= iTableColumns - 2 Then |
0120 | If Len(rsTableToRead.Fields(iFieldNo) & "") = 0 Then |
0121 | strLine = " " |
0122 | Else |
0123 | Select Case rsTableToRead.Fields(iFieldNo).Name |
0124 | Case "Title" |
0125 | If rsTableToRead.Fields(5).Value = "." Then 'No further information |
0126 | strLine = rsTableToRead.Fields(iFieldNo).Value |
0127 | Else |
0128 | If rsTableToRead.Fields(iTableColumns - 2) = "Paper" Then |
0129 | strLine = "" & rsTableToRead.Fields(iFieldNo).Value & "" |
0130 | Else |
0131 | strLine = "" & rsTableToRead.Fields(iFieldNo).Value & "" |
0132 | End If |
0133 | End If |
0134 | Case "Further Information" |
0135 | Saved_Link_Type = rsTableToRead.Fields(iTableColumns - 2) |
0136 | Saved_ObjectID = ObjectID |
0137 | If rsTableToRead.Fields(iFieldNo).Value = "." Then |
0138 | If Saved_Link_Type = "Paper" Then |
0139 | strLine = "Paper | | "
0140 | Else |
0141 | strLine = "Book | | "
0142 | End If |
0143 | Else |
0144 | If Saved_Link_Type = "Paper" Then |
0145 | strLine = "Paper Abstract" |
0146 | Else |
0147 | strLine = "Book Abstract" |
0148 | End If |
0149 | strLine = strLine & rsTableToRead.Fields(iFieldNo).Value & " | "
0150 | rsTableToRead.MoveNext |
0151 | DoneEnough = False |
0152 | If Not rsTableToRead.EOF Then |
0153 | strLine = strLine & "" | |
0154 | StrComma = "" |
0155 | iExtras = 1 |
0156 | Do Until DoneEnough = True |
0157 | If Saved_Link_Type = rsTableToRead.Fields(iTableColumns - 2) And ObjectID = rsTableToRead.Fields(iTableColumns - 3) And Book_ID = rsTableToRead.Fields(0) Then |
0158 | If Saved_Link_Type = "Paper" Then |
0159 | strLine = strLine & StrComma & "" & iExtras & "" |
0160 | Else |
0161 | strLine = strLine & StrComma & "" & iExtras & "" |
0162 | End If |
0163 | rsTableToRead.MoveNext |
0164 | If rsTableToRead.EOF Then |
0165 | DoneEnough = True |
0166 | rsTableToRead.MovePrevious |
0167 | Else |
0168 | StrComma = ", " |
0169 | iExtras = iExtras + 1 |
0170 | End If |
0171 | Else |
0172 | DoneEnough = True |
0173 | rsTableToRead.MovePrevious |
0174 | End If |
0175 | Loop |
0176 | strLine = strLine & " | "
0177 | Else |
0178 | strLine = strLine & " | " |
0179 | rsTableToRead.MovePrevious |
0180 | End If |
0181 | End If |
0182 | Case Else |
0183 | If iFieldNo = 6 Then |
0184 | strLine = "" |
0185 | Else |
0186 | strLine = rsTableToRead.Fields(iFieldNo) |
0187 | End If |
0188 | End Select |
0189 | End If |
0190 | strLine = ReplaceCode(strLine, Chr(13) & Chr(10), " ") |
0191 | tsTextFile.WriteLine strLine |
0192 | End If |
0193 | Else |
0194 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0195 | End If |
0196 | rsTableControl.MoveNext |
0197 | Loop |
0198 | rsTableToRead.MoveNext |
0199 | Loop |
0200 | 'Write the Last Footer |
0201 | 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;" |
0202 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0203 | rsTableControl.MoveFirst |
0204 | Do While Not rsTableControl.EOF |
0205 | Time_Stamp = rsTableControl.Fields(0) & "" |
0206 | OK = Replace_Timestamp(Time_Stamp) |
0207 | tsTextFile.WriteLine Time_Stamp |
0208 | rsTableControl.MoveNext |
0209 | Loop |
0210 | OK = CopyToTransfer(strFolder & strFileBody & "\", strFileSuffix & ".htm") |
0211 | iCount = iCount + 1 |
0212 | End If |
0213 | If Automatic = "No" Then |
0214 | MsgBox strOutputFile & "Book to Citing Book / Paper Links Creation Complete, in " & Round((Now() - StartTime) * 24 * 60, 1) & " minutes. " & iCount & " pages output.", vbOKOnly, "Create Book Citation Pages" |
0215 | End If |
0216 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub CreatePaperCitingsWebPages(Automatic) |
0002 | 'This is a new module to generate the pages that list the Books and Papers that (via my Abstract / Comments) cite a particular Paper. |
0003 | 'It was based on Sub CreateAuthorsWebPages |
0004 | 'Called by WebpagePaperCitings |
0005 | Dim fsoTextFile As FileSystemObject |
0006 | Dim tsTextFile As TextStream |
0007 | Dim rsTableToRead As Recordset |
0008 | Dim rsPapers As Recordset |
0009 | Dim rsTableControl As Recordset |
0010 | Dim strControlQuery As String |
0011 | Dim strLine As String |
0012 | Dim iTableColumns As Integer |
0013 | Dim iFieldNo As Integer |
0014 | Dim x As Integer |
0015 | Dim strQry As String |
0016 | Dim i As Integer |
0017 | Dim Paper_ID As Integer |
0018 | Dim Paper_ID_Previous As Integer |
0019 | Dim ObjectID As Integer |
0020 | Dim strFileSuffix As String |
0021 | Dim strFileBody As String |
0022 | Dim StartTime As Double |
0023 | Dim Time_Stamp As String |
0024 | Dim strAuthors As String |
0025 | Dim strPaper As String |
0026 | Dim iCount As Long |
0027 | iCount = 0 |
0028 | Set fsoTextFile = New FileSystemObject |
0029 | strFolder = strOutputFolder |
0030 | StartTime = Now() |
0031 | 'Read the data for Citations of this Paper |
0032 | Set rsTableToRead = CurrentDb.OpenRecordset(strDataQuery) |
0033 | If Not rsTableToRead.EOF Then |
0034 | rsTableToRead.MoveFirst |
0035 | iTableColumns = rsTableToRead.Fields.Count |
0036 | 'Column 0 is the Paper ID, Anti-Penultimate Column is the Object ID, the Penultimate Column says whether it's a Book or a Paper; the last column is the reference on the page |
0037 | Paper_ID_Previous = 0 'There is no Paper_ID 0 |
0038 | strFileSuffix = "" |
0039 | strFileBody = "" |
0040 | Do Until rsTableToRead.EOF |
0041 | Paper_ID = rsTableToRead.Fields(0) |
0042 | ObjectID = rsTableToRead.Fields(iTableColumns - 3) |
0043 | If Paper_ID_Previous <> Paper_ID Then 'New Paper |
0044 | 'Read the Paper Author & Title |
0045 | strQry = "Select Papers.Title, Papers.Author from Papers Where Papers.ID = " & Paper_ID & ";" |
0046 | Set rsPapers = CurrentDb.OpenRecordset(strQry) |
0047 | If Not rsPapers.EOF Then |
0048 | rsPapers.MoveFirst |
0049 | strAuthors = rsPapers.Fields(1) |
0050 | strPaper = rsPapers.Fields(0) |
0051 | Else |
0052 | strAuthors = "Unknown Author" |
0053 | strPaper = "Unknown Paper" |
0054 | End If |
0055 | 'Write the previous Footer (except first time) |
0056 | If Paper_ID_Previous <> 0 Then |
0057 | 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;" |
0058 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0059 | rsTableControl.MoveFirst |
0060 | Do While Not rsTableControl.EOF |
0061 | Time_Stamp = rsTableControl.Fields(0) & "" |
0062 | OK = Replace_Timestamp(Time_Stamp) |
0063 | tsTextFile.WriteLine Time_Stamp |
0064 | rsTableControl.MoveNext |
0065 | Loop |
0066 | OK = CopyToTransfer(strFolder & strFileBody & "\", strFileSuffix & ".htm") |
0067 | iCount = iCount + 1 |
0068 | End If |
0069 | Paper_ID_Previous = Paper_ID |
0070 | strFileSuffix = strOutputFileShort & "_" & Paper_ID |
0071 | strFileBody = "PaperSummary_" & Mid(100000 + Paper_ID, 2, 2) |
0072 | 'Create File |
0073 | Set tsTextFile = fsoTextFile.CreateTextFile(strOutputFolder & strFileBody & "\" & strFileSuffix & ".htm", True, True) |
0074 | 'Page Header |
0075 | 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;" |
0076 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0077 | rsTableControl.MoveFirst |
0078 | Do While Not rsTableControl.EOF |
0079 | strLine = rsTableControl.Fields(0) & "" |
0080 | x = InStr(1, strLine, "**PAPER**") |
0081 | If x > 0 Then |
0082 | 'Add the Paper Title |
0083 | strLine = Left(strLine, x - 1) & "" & strPaper & "" & Mid(strLine, x + 9, Len(strLine)) |
0084 | End If |
0085 | x = InStr(1, strLine, "**AUTHOR**") |
0086 | If x > 0 Then |
0087 | 'Add the Paper Author |
0088 | OK = Author_Reference_String(strAuthors, 2) |
0089 | strLine = Left(strLine, x - 1) & strAuthors & Mid(strLine, x + 10, Len(strLine)) |
0090 | End If |
0091 | tsTextFile.WriteLine strLine |
0092 | rsTableControl.MoveNext |
0093 | Loop |
0094 | 'Read Table-Control for rows |
0095 | strControlQuery = "SELECT Website_Control.Line_Value FROM Website_Control WHERE (((Website_Control.Web_Page) = """ & strControlTable & """) And ((Website_Control.Section) = ""Table_Row"")) ORDER BY Website_Control.Line;" |
0096 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0097 | 'Table Column Headings |
0098 | rsTableControl.MoveFirst |
0099 | Do While Not rsTableControl.EOF |
0100 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0101 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0102 | 'Note: Fields start at 0, but the first one in the query is the Paper, and the last one is the Object ID |
0103 | If iFieldNo > 0 And iFieldNo <= iTableColumns - 2 Then |
0104 | tsTextFile.WriteLine " " & rsTableToRead.Fields(iFieldNo).Name & "" |
0105 | End If |
0106 | Else |
0107 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0108 | End If |
0109 | rsTableControl.MoveNext |
0110 | Loop |
0111 | End If |
0112 | 'Table Row |
0113 | rsTableControl.MoveFirst |
0114 | Do While Not rsTableControl.EOF |
0115 | If Left(rsTableControl.Fields(0), 8) = "**Column" Then |
0116 | iFieldNo = Val(Mid(rsTableControl.Fields(0), 9, 2)) |
0117 | If iFieldNo > 0 And iFieldNo <= iTableColumns - 2 Then |
0118 | If Len(rsTableToRead.Fields(iFieldNo) & "") = 0 Then |
0119 | strLine = " " |
0120 | Else |
0121 | Select Case rsTableToRead.Fields(iFieldNo).Name |
0122 | Case "Title" |
0123 | If rsTableToRead.Fields(5).Value <> "." Then |
0124 | If rsTableToRead.Fields(iTableColumns - 2) = "Paper" Then |
0125 | strLine = "" & rsTableToRead.Fields(iFieldNo) & "" |
0126 | Else |
0127 | strLine = "" & rsTableToRead.Fields(iFieldNo) & "" |
0128 | End If |
0129 | Else |
0130 | strLine = rsTableToRead.Fields(iFieldNo) |
0131 | End If |
0132 | Case "Further Information" |
0133 | If rsTableToRead.Fields(iFieldNo).Value = "." Then |
0134 | If rsTableToRead.Fields(iTableColumns - 2) = "Paper" Then |
0135 | strLine = "Paper" |
0136 | Else |
0137 | strLine = "Book" |
0138 | End If |
0139 | Else |
0140 | If rsTableToRead.Fields(iTableColumns - 2) = "Paper" Then |
0141 | strLine = "Paper Abstract" |
0142 | Else |
0143 | strLine = "Book Abstract" |
0144 | End If |
0145 | strLine = strLine & rsTableToRead.Fields(iFieldNo).Value |
0146 | End If |
0147 | Case Else |
0148 | strLine = rsTableToRead.Fields(iFieldNo) |
0149 | End Select |
0150 | End If |
0151 | strLine = ReplaceCode(strLine, Chr(13) & Chr(10), " ") |
0152 | tsTextFile.WriteLine strLine |
0153 | End If |
0154 | Else |
0155 | tsTextFile.WriteLine rsTableControl.Fields(0) & "" |
0156 | End If |
0157 | rsTableControl.MoveNext |
0158 | Loop |
0159 | rsTableToRead.MoveNext |
0160 | Loop |
0161 | 'Write the Last Footer |
0162 | 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;" |
0163 | Set rsTableControl = CurrentDb.OpenRecordset(strControlQuery) |
0164 | rsTableControl.MoveFirst |
0165 | Do While Not rsTableControl.EOF |
0166 | Time_Stamp = rsTableControl.Fields(0) & "" |
0167 | OK = Replace_Timestamp(Time_Stamp) |
0168 | tsTextFile.WriteLine Time_Stamp |
0169 | rsTableControl.MoveNext |
0170 | Loop |
0171 | OK = CopyToTransfer(strFolder & strFileBody & "\", strFileSuffix & ".htm") |
0172 | iCount = iCount + 1 |
0173 | End If |
0174 | If Automatic = "No" Then |
0175 | MsgBox strOutputFile & "Paper to Citing Book / Paper Links Creation Complete, in " & Round((Now() - StartTime) * 24 * 60, 1) & " minutes. " & iCount & " pages output.", vbOKOnly, "Create Paper Citation Pages" |
0176 | End If |
0177 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Notes_Move_Control() |
0002 | 'This is a new module to read the html files and update the Notes directories |
0003 | 'It was based on http://www.tutorial-web.com/asp/fso/textstream |
0004 | 'Needs to run twice for secure and open Notes |
0005 | Dim fso As FileSystemObject |
0006 | Dim tsTextFileIn As TextStream |
0007 | Dim InFile As String |
0008 | Dim DirectoryName As String |
0009 | Dim MainFolder |
0010 | Dim FileCollection |
0011 | Dim File |
0012 | Dim File_Name As String |
0013 | Dim Note_ID As String |
0014 | Dim New_Directory As String |
0015 | Dim New_File_Name As String |
0016 | Set fso = CreateObject("Scripting.FileSystemObject") |
0017 | DirectoryName = "C:\Theo's Files\Websites\Theo's Website\Secure_Jen\" |
0018 | Set MainFolder = fso.GetFolder(DirectoryName) |
0019 | Set FileCollection = MainFolder.Files |
0020 | For Each File In FileCollection |
0021 | File_Name = File.Name |
0022 | Note_ID = Find_NoteID(File_Name) 'Determine Note_ID |
0023 | If Note_ID = "" Then |
0024 | Debug.Print Now() & " - "; "ID not Found" |
0025 | Else |
0026 | InFile = DirectoryName & File_Name |
0027 | Set tsTextFileIn = fso.OpenTextFile(InFile, 1, False, 0) 'Open the file |
0028 | New_Directory = "Notes_" & Find_New_Directory(Note_ID) 'Determine New Folder |
0029 | New_File_Name = DirectoryName & New_Directory & "\" & File_Name |
0030 | New_Directory = New_Directory & "/" |
0031 | 'Convert the references in the file (copying as we go) |
0032 | OK = CopyReplace_TextStream(InFile, New_File_Name, New_Directory) |
0033 | Set tsTextFileIn = Nothing |
0034 | End If |
0035 | Next |
0036 | Set fso = Nothing |
0037 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Sub Notes_Print_Move_Control() |
0002 | 'This is a new module to read the html files and update the Notes directories |
0003 | 'It was based on http://www.tutorial-web.com/asp/fso/textstream |
0004 | 'Needs to run twice for secure and open Notes |
0005 | Dim fso As FileSystemObject |
0006 | Dim tsTextFileIn As TextStream |
0007 | Dim InFile As String |
0008 | Dim DirectoryName As String |
0009 | Dim SubDirectoryName As String |
0010 | Dim MainFolder |
0011 | Dim FileCollection |
0012 | Dim File |
0013 | Dim File_Name As String |
0014 | Dim Note_ID As String |
0015 | Dim New_Directory As String |
0016 | Dim New_File_Name As String |
0017 | Set fso = CreateObject("Scripting.FileSystemObject") |
0018 | DirectoryName = "C:\Theo's Files\Websites\Theo's Website\Notes\" |
0019 | SubDirectoryName = "Notes_Print\" |
0020 | Set MainFolder = fso.GetFolder(DirectoryName & SubDirectoryName) |
0021 | Set FileCollection = MainFolder.Files |
0022 | For Each File In FileCollection |
0023 | File_Name = File.Name |
0024 | Note_ID = Find_NoteID_Print(File_Name) 'Determine Note_ID |
0025 | If Note_ID = "" Then |
0026 | Debug.Print Now() & " - "; "ID not Found" |
0027 | Else |
0028 | InFile = DirectoryName & SubDirectoryName & File_Name |
0029 | Set tsTextFileIn = fso.OpenTextFile(InFile, 1, False, 0) 'Open the file |
0030 | New_Directory = "Notes_" & Find_New_Directory(Note_ID) 'Determine New Folder |
0031 | New_File_Name = DirectoryName & New_Directory & "\" & SubDirectoryName & File_Name |
0032 | New_Directory = New_Directory & "/" |
0033 | 'Convert the references in the file (copying as we go) |
0034 | OK = CopyReplace_TextStreamPrint(InFile, New_File_Name) |
0035 | Set tsTextFileIn = Nothing |
0036 | End If |
0037 | Next |
0038 | Set fso = Nothing |
0039 | End Sub |
Line-No. / Ref. | Code Line |
0001 | Public Function ReplaceNoteLink(strString, Marker, Ignore_String) |
0002 | 'This module adds Pre_Addition pror to Marker anywhere in strString, provided Ignore_String doesn't start in the same place as Marker |
0003 | 'The primary usage is to convert references in Notes consequent on adding an extra level of directory structure |
0004 | Dim lenString As Long |
0005 | Dim lenMarker As Long |
0006 | Dim lenPre As Long |
0007 | Dim lenIgn As Long |
0008 | Dim strTemp As String |
0009 | Dim x As Long |
0010 | Dim Y As Long |
0011 | Dim NoteID As String |
0012 | Dim Pre_Addition As String |
0013 | Dim len_PreRemoval As Long |
0014 | strTemp = strString |
0015 | lenString = Len(strTemp) |
0016 | lenMarker = Len(Marker) |
0017 | lenIgn = Len(Ignore_String) |
0018 | x = 1 |
0019 | Y = 1 |
0020 | Do While Y > 0 |
0021 | Y = InStr(x, strTemp, Marker) |
0022 | If Y > 0 Then |
0023 | If Mid(strTemp, Y, lenIgn) = Ignore_String Then |
0024 | x = Y + 1 |
0025 | Else |
0026 | 'Need to determine the right sub-directory |
0027 | NoteID = Find_NoteID2(Mid(strTemp, Y, Len(strTemp))) |
0028 | If NoteID <> "" Then |
0029 | 'Check if a cross-security link |
0030 | If Right(Left(strTemp, Y - 1), 9) = "../Notes/" Then |
0031 | Pre_Addition = "../../Notes/" |
0032 | len_PreRemoval = 9 |
0033 | Else |
0034 | If Right(Left(strTemp, Y - 1), 14) = "../Secure_Jen/" Then |
0035 | Pre_Addition = "../../Secure_Jen/" |
0036 | len_PreRemoval = 14 |
0037 | Else |
0038 | Pre_Addition = "../" |
0039 | len_PreRemoval = 0 |
0040 | End If |
0041 | End If |
0042 | Pre_Addition = Pre_Addition & "Notes_" & Find_New_Directory(NoteID) & "/" |
0043 | Else |
0044 | Pre_Addition = "" |
0045 | len_PreRemoval = 0 |
0046 | End If |
0047 | lenPre = Len(Pre_Addition) |
0048 | 'Adjust the string |
0049 | strTemp = Left(strTemp, Y - 1 - len_PreRemoval) & Pre_Addition & Mid(strTemp, Y, lenString) |
0050 | lenString = Len(strTemp) |
0051 | x = Y - len_PreRemoval + lenPre + 1 |
0052 | End If |
0053 | End If |
0054 | Loop |
0055 | ReplaceNoteLink = strTemp |
0056 | End Function |