Private Sub CreateWalkTour()
' is button on Dashboard sheet
Dim i As Integer, j As Integer
Dim f As String, H As String, Path As String, t As String
Dim NextFN As String, NextFT As String, PrevFN As String, PrevFT As String
Dim Data, Names, Indxs, res, temp As Variant
Path = "C:\Internet\WEBPAGES\greenportwalkingtour.org"
Names = ExtractDataNames(Path & "\StopText.txt")
' we have to put the names in walk number order
ReDim Indxs(UBound(Names), 2)
For i = 0 To UBound(Names)
t = ExtractData(Path & "\StopText.txt", Names(i), 2)
If Left(t, 7) = "Ireland" Then
Indxs(i, 0) = "A"
Else
t = Left(t, InStr(t, ".") - 1)
t = DropStr(t, 1)
Indxs(i, 0) = Format(t, "00")
End If
Indxs(i, 1) = Names(i)
' get our title tags (we need upfront for navigation)
t = ExtractData(Path & "\StopText.txt", Indxs(i, 1), 2)
' remove date from title string
res = AllInStr(t, " ")
If UBound(res) = 1 Then
t = Left(t, res(0) - 1)
Else
t = Left(t, res(2) - 1)
End If
Indxs(i, 2) = t
Next i
Indxs = SortMatrix(Indxs, 0, True)
' ~~ build htms
For i = 0 To UBound(Indxs)
Data = ExtractData(Path & "\StopText.txt", Indxs(i, 1), 3)
H = "" & vbCrLf
H = H & "" & vbCrLf
H = H & "" & vbCrLf
H = H & "Greenport Walking Tour: " & Indxs(i, 2) & "" & vbCrLf
H = H & "" & vbCrLf
H = H & "" & vbCrLf
H = H & "" & vbCrLf
H = H & "" & vbCrLf
H = H & "
" & vbCrLf
H = H & ExtractData(Path & "\StopPics.txt", Indxs(i, 1), 1) & vbCrLf
H = H & "" & vbCrLf & "" & vbCrLf
SaveIfChanged Path & "\" & Indxs(i, 1) & ".htm", H
Next i
' ~~~~ build index page code
' ~~ loop through in ordinal order
H = ""
For i = 0 To UBound(Indxs)
' is there code before it?
t = ExtractData(Path & "\BeforesCode.txt", Indxs(i, 0), 1)
If t <> "" Then
H = H & t & vbCrLf
End If
Data = ExtractData(Path & "\StopText.txt", Indxs(i, 1), 3)
' is there a picture?
f = Path & "\images\wt" & Indxs(i, 0) & ".gif"
If FileExists(f) Then
H = H & "" & vbCrLf
End If
H = H & "
" & vbCrLf
t = Data(0)
If Left(t, 1) <> "#" Then
j = InStr(t, ",") - 1
t = "" & Left(t, j) & "" & DropStr(t, j)
Else
res = AllInStr(t, ";")
j = InStr(t, ",") - 1
If j = -1 Then
temp = AllInStr(t, "&")
j = temp(2) - 1
End If
t = Left(t, res(1)) & "" & Mid(t, res(1) + 1, j - res(1)) & "" & DropStr(t, j)
End If
H = H & t
H = H & Left(Data(1), Len(Data(1)) - 10) & vbCrLf
H = H & "Photo"
If 1 < CountInString(ExtractData(Path & "\StopPics.txt", Indxs(i, 1), 1), "img src") Then
H = H & "s"
End If
H = H & "" & vbCrLf
H = H & "
" & vbCrLf & "" & vbCrLf & vbCrLf
H = H & "
" & vbCrLf & vbCrLf
Next i
InsertIntoHtm Path & "\walk-tour.htm", H
' ~~~~ insert into thumbnails page
H = ""
For i = 0 To UBound(Indxs)
f = "images/" & Indxs(i, 1) & "-tn.jpg"
H = H & "
" & vbCrLf
Next i
InsertIntoHtm Path & "\thumbnails.htm", H & vbCrLf
' we also run navigation for index page
AddNavCodeFromOtherSheet Path
' save list of names to use for audio map and note taking
t = Ravel(ReturnColumn(Indxs, 2), vbCrLf, , " ")
t = Replace(t, " ", " ")
t = Replace(t, " ", " ")
t = Replace(t, "", "")
t = Replace(t, "", "")
SaveIfChanged Path & "\ListOfBuildings.txt", t
End Sub