html - 如何使用 VBA 缩进 HTML？

Question

我正在 VBA (MSACCESS) 中生成一些 HTML，它工作正常，但从缩进的角度来看有点困惑。
有没有一种简单的方法可以在 VBA 中缩进 HTML 文本流？
我使用 Visual Studio Code 格式功能来制作更漂亮的 HTML，但我必须手动完成，而且非常乏味!

例子:

<div class="anythinggoes">
<ul><li>A</li>
        <li>B</li><li>C</li>
    </ul></div> <!-- anythinggoes -->

应该变成这样:

<div class="anythinggoes">
    <ul>
        <li>A</li>
        <li>B</li>
        <li>C</li>
    </ul>
</div> <!-- anythinggoes -->

任何帮助都感激不尽!

Answer 1

警告!前面的代码很丑!
欢迎加入，RichD。我认为此代码可能对您有所帮助:
首先，在 Module 作用域中定义这些变量:

Private InlineTags As Variant
Private InlineClosingTags As Variant
Private LineBreakTags As Variant

然后，我们可以使用这个函数:

Function ReadableHTML(HTML As String) As String
    Dim a$, i&, TabsNo&, tabs$, l&, tag$, MaxTabs&

    'add here tags that you want to keep on the same line of their parent
    InlineTags = Array("!--", "a", "i", "b", "sup", "sub", "strong") 'never followed by a line break
    InlineClosingTags = Array("li", "h1", "h2", "h3", "h4") 'always followed by a line break
    LineBreakTags = Array("br", "br/", "br /") 'always lead & followed by a line break

    a = CleanOf(HTML)
    TabsNo = -1
    i = 1
    l = Len(a)
    Do While i < l
        If Mid(a, i, 2) = "</" Then
            tag = Mid(a, i + 2, InStr(i + 2, a, ">") - i - 2)
            If Not IsInArray(tag, InlineClosingTags) Or Mid(a, i - 1, 1) = ">" Then
                tabs = Chr(10) & Filler(TabsNo, Chr(9))
                a = Left(a, i - 1) & tabs & Right(a, Len(a) - i + 1)
                l = Len(a)
                i = i + Len(tabs)
            End If
            TabsNo = TabsNo - 1
        Else
            Select Case Mid(a, i, 1)
            Case "<"
                tag = Mid(a, i + 1, InStr(i + 1, a, ">") - i - 1)
                If Not IsInArray(tag, InlineTags) Then
                    TabsNo = TabsNo + 1
                    If TabsNo > MaxTabs Then MaxTabs = TabsNo
                    If i > 1 Then tabs = Chr(10) & Filler(TabsNo, Chr(9)) Else tabs = Filler(TabsNo, Chr(9))
'                    tabs = tabs & Filler(TabsNo, Chr(9))
                    a = Left(a, i - 1) & tabs & Right(a, Len(a) - i + 1)
                    l = Len(a)
                    i = i + Len(tabs)
                    If IsInArray(tag, LineBreakTags) Then TabsNo = TabsNo - 1
                End If
            Case ">"
                tag = Mid(a, InStrRev(a, "<", i) + 1, i - InStrRev(a, "<", i) - 1)
                If Not IsInArray(tag, InlineClosingTags) Then
                    tabs = Chr(10) & Filler(TabsNo + 1, Chr(9))
                    a = Left(a, i) & tabs & Right(a, Len(a) - i)
                End If
            Case Chr(10)
                If Mid(a, i + 1, 1) <> Chr(9) And Mid(a, i + 1, 1) <> "<" Then
                    tabs = Chr(10) & Filler(TabsNo + 1, Chr(9))
                    a = Left(a, i) & tabs & Right(a, Len(a) - i)
                    l = Len(a)
                    i = i + Len(tabs)
                End If
            End Select
        End If
        i = i + 1
    Loop
    For TabsNo = MaxTabs To 0 Step -1
        a = Replace(a, Chr(10) & Filler(TabsNo, Chr(9)) & Chr(10), Chr(10))
    Next
    ReadableHTML = treatInlineTags(a, False)
End Function

其中使用这些帮助功能:

Function treatInlineTags(a As String, HideFlag As Boolean)
    'Hides/unhides inline tags from CleanOf
    If HideFlag Then
        For i = LBound(InlineTags) To UBound(InlineTags)
            a = Replace(a, "<" & InlineTags(i) & " ", "|" & InlineTags(i) & "¦")
            a = Replace(a, "<" & InlineTags(i) & ">", "|" & InlineTags(i) & "|")
            a = Replace(a, "</" & InlineTags(i) & ">", "|/" & InlineTags(i) & "|")
        Next i
    Else
        For i = LBound(InlineTags) To UBound(InlineTags)
            a = Replace(a, "|" & InlineTags(i) & "¦", "<" & InlineTags(i) & " ")
            a = Replace(a, "|" & InlineTags(i) & "|", "<" & InlineTags(i) & ">")
            a = Replace(a, "|/" & InlineTags(i) & "|", "</" & InlineTags(i) & ">")
        Next i
    End If
    treatInlineTags = a
End Function

Function IsInArray(a As String, Arr As Variant) As Boolean
    Dim i As Long
    For i = LBound(Arr) To UBound(Arr)
        IsInArray = a = Arr(i)
        If IsInArray Then Exit Function
    Next i
End Function

Function CleanOf(a As String) As String
    'Removes unwanted spaces between tags
    Dim i As Long, b As Boolean, l As Long
    a = Replace(a, Chr(13), "")
    a = Replace(a, Chr(10), "")
    a = treatInlineTags(a, True)
    For i = 1 To Len(a)
        Select Case Mid(a, i, 1)
        Case ">", "<"
            If i - l > 1 And l > 0 Then a = Left(a, l) & Right(a, Len(a) - i + 1)
            If i > 1 Then l = i
            If l > 0 Then b = True
        Case Is <> " "
            b = False
            l = 0
        End Select
    Next i
    CleanOf = a
End Function

Function Filler(n As Long, Optional Str As String = "0") As String
    If n > 0 Then Filler = Replace(Space$(n), " ", Str)
End Function

要测试它:

Sub test()
    Dim a As String, b As String
    a = "<div class=""myclass""> " & Chr(13) & _
    "<ul><li>A</li>                   " & Chr(13) & _
    "<li>B</li><li>C</li>             " & _
    "</ul></div> <!-- just a comment -->" & _
    "<h2 class=""mytitle"">a title: inline and " & _
    "followed by a line break</h2>" & _
    "<div><ul><li><i class=""myitalic"">italic " & _
    "content: inline and NOT followed by a line break</i>" & _
    "</li></ul></div>"
    
    b = "<li><i class=""mylist""></i>a list <ul>" & _
    "<li>element 1</li><li>element 2</li><li>element 3</li></ul> " & _
    "</li><li>This <b>is bold</b> in an element list " & _
    "<a href=""#mydestination"">""with an href"" " & _
    "</a></li>"
    
    Debug.Print Chr(10) & "Test1 - input:" & Chr(10) & a
    Debug.Print Chr(10) & "Test1 - output:" & Chr(10) & ReadableHTML(a)
    
    Debug.Print Chr(10) & "Test2 - input:" & Chr(10) & b
    Debug.Print Chr(10) & "Test2 - output:" & Chr(10) & ReadableHTML(b)
End Sub