Here is a replacement routine that I wrote. I am sure that it can be improved, so I would love to hear some feedback. It is pretty easy to implement, just replace old routine with the contents of the code listed below.
Thanks to Ben for doing this! And thanks to Ralph for the table replacement routine, it was the starting point of my routine :-)
I hope you enjoy it!
- gerry.
p.s. - I thought you could upload files, but I guess not, sorry for the long message!
--------------------
<code>
' Gerry Riddell 15-Aug-2007: Multi-level List Support wrapper
' Supported formats are:
' UnOrdered Lists: *-*** <line item text>
' Ordered Lists: %-%%% <line item text>
'
Public Function parseLists (txt As String) As String
'** lines beginning with "*" are unordered bullet line items
parseLists = parseMultiLists (txt, "ul", "*")
'** lines beginning with "%" are ordered bullet line items
parseLists = parseMultiLists (parseLists, "ol", "%")
End Function
' Gerry Riddell 15-Aug-2007: Multi-level List Support main routine
' NOTE:
' 1) currently this is limited to three levels of lists
' 2) DO NOT mix and match ordered and unordered lists or you WILL get varying results
' with some twiddling you can get things to sometimes work, but use with caution
'
'TODO:
' 1) Allow unordered and ordered lists to interact nicely together
' 2) Allow unlimited levels of lists
' 3) Fix any efficiencies (like maybe the linebreak routine)
'
Private Function parseMultiLists (txt As String, sTag As String, sBullet As String) As String
Dim vInput As Variant
Dim sValue As String
Dim iLevel As Integer
Dim i As Integer
iLevel = 0
' Loop through input text line by line
vInput = Split(txt, Chr(10))
For i = Lbound(vInput) To Ubound(vInput)
If Left(vInput(i), 3) = Ustring(3, sBullet) Then
vInput(i) = parseListItem (vInput(i), 3, iLevel, sTag)
' set the current level
iLevel = 3
Elseif Left(vInput(i), 2) = Ustring(2, sBullet) Then
vInput(i) = parseListItem (vInput(i), 2, iLevel, sTag)
' set the current level
iLevel = 2
Elseif Left(vInput(i), 1) = sBullet Then
vInput(i) = parseListItem (vInput(i), 1, iLevel, sTag)
' set the current level
iLevel = 1
Else
' No longer in list so close all levels, if needed
If iLevel > 0 Then
vInput(i) = vInput(i) & parseListItem ("", 0, iLevel, sTag)
' set the current level
iLevel = 0
End If
End If
Next
' set up the various end of line conbinations so we can remove line breaks
Dim array1(5) As String
Dim array2(5) As String
array1(0) = "</" & sTag & ">" & Chr(10) & "<" & sTag & ">"
array1(1) = "</li>" & Chr(10) & "<" & sTag & ">"
array1(2) = "</" & sTag & ">" & Chr(10) & "<li>"
array1(3) = "</li>" & Chr(10) & "</" & sTag & ">"
array1(4) = "</" & sTag & ">" & Chr(10) & "</li>"
array1(5) = "</li>" & Chr(10) & "<li>"
array2(0) = "</" & sTag & "><" & sTag & ">"
array2(1) = "</li><" & sTag & ">"
array2(2) = "</" & sTag & "><li>"
array2(3) = "</li></" & sTag & ">"
array2(4) = "</" & sTag & "></li>"
array2(5) = "</li><li>"
' Return string -- close list, if needed
parseMultiLists = Implode(vInput, Chr(10))
parseMultiLists = Replace(parseMultiLists, array1, array2)
If iLevel > 0 Then
' close the necessary list containers
parseMultiLists = parseMultiLists & parseListItem ("", 0, iLevel, sTag)
End If
End Function
' Gerry Riddell 15-Aug-2007: Multi-level List Support line item routine
Private Function parseListItem (txt As String, newLevel As Integer, currLevel As Integer, tag As String) As String
Dim i As Integer
If newLevel > currLevel Then
' create the necessary list containers
For i = 1 To (newLevel-currLevel)
parseListItem = parseListItem & "<" & tag & ">"
Next
Elseif newLevel < currLevel Then
For i = 1 To (currLevel-newLevel)
parseListItem = parseListItem & "</" & tag & ">"
Next
End If
' form the actual line entry
If Len(txt) > 0 Then
parseListItem = parseListItem & "<li>" & Right(txt, Len(txt)-newLevel) & "</li>"
End If
End Function
</code>