如何根据规则提取内容，我已经写了如下代码，但是有点小问题，请各位大大帮忙看看，分不够再加。

Question

Option Explicit
Public CONN As New ADODB.Connection
Public RS As New ADODB.Recordset
Public strSQL As String
Public strConnect As String
Public endContent As String '最终内容
Public endFailds As String '最终字段
Public Sub ConnectDB()
    strConnect = App.path & "\WebGetDB.mdb"
    CONN.CursorLocation = adUseClient
    If RS.State = 1 Then RS.Close
    strConnect = "provider = microsoft.jet.oledb.4.0;persist security info=false;data source = " & strConnect
    If CONN.State = 1 Then CONN.Close
    CONN.Open strConnect
'    Exit Sub
End SubPublic Sub Check_RS()
    If RS.State = 1 Then RS.Close
End Sub
Private Sub getSub2(keyID As Integer, allContent2 As String)
Dim varStart As String
Dim varEnd As String
Dim RS2 As New ADODB.Recordset
Dim strSQL2 As String
'    Check_RS
    strSQL2 = "SELECT ProjectID,ParentID,inStart,inEnd,isSave2Data,dataFaild From wgProject2 WHERE ParentID=" & keyID
    RS2.Open strSQL2, CONN, adOpenKeyset, adLockOptimistic 'adOpenForwardOnly,adOpenKeyset,adOpenStatic
    If Not RS2.BOF Or Not RS2.EOF Then
'        Debug.Print strSQL2
'        Debug.Print RS2(1)
        Do While Not RS2.EOF
    
            varStart = RS2("inStart")
            varEnd = RS2("inEnd")
    
            If InStr(allContent2, varStart) > 0 And InStr(allContent2, varEnd) > 0 Then
'                Debug.Print varStart
'                Debug.Print varEnd
                
    
                allContent2 = Split(allContent2, varStart)(1)
                allContent2 = Split(allContent2, varEnd)(0)
'                Debug.Print allContent2
                If RS2("isSave2Data") = True Then
                    endFailds = endFailds & "," & RS2("dataFaild")
                    endContent = endContent & "," & allContent2
                End If
'                Debug.Print endContent
                getSub2 RS2("ProjectID"), allContent2
            End If
            RS2.MoveNext
        Loop
    End If
    RS2.Close
    Set RS2 = Nothing
End Sub
Private Sub Form_Load()
ConnectDB '连接数据库
getSub2 1, "xxxx<a>a<a1><1>1</1><2>2</2></a1><a2>a2</a2></a>xxxxxxxxx"
MsgBox endContent
End Sub================================================
我的目的是把"xxxx<a>a<a1><1>1</1><2>2</2></a1><a2>a2</a2></a>xxxxxxxxx"这段内容中的某些特定内容提取出来，规则就设置在数据库中。我想方法是对的，可是提取的最终结果有点偏差，请教各位大大。

Answer 1

最好说一下你的规则是什么?具体怎么写,得看你的规则到底是什么.我看到你用split来拆分,却弄不明白你为什么要拆分,拆分成数组后你怎么处理?

Answer 2

举例来说吧有段文字
第一步取得
<a> <b> <c1> <d1> <e1> </e1> 1 <e2> 2 </e2> </d1> <d2> <e3> 3 </e3> </d2> </c1> </b>  </a>   第二步取得
<b> <c1> <d1> <e1> </e1> 1 <e2> 2 </e2> </d1> </d1> <d2> <e3> 3 </e3> </d2> </c1> </b>第三步取得
<c1> <d1> <e1> </e1> 1 <e2> 2 </e2> </d1> </d1> <d2> <e3> 3 </e3> </d2> </c1>第四步取得
<d1> <e1> </e1> 1 <e2> 2 </e2> </d1>
<d2> <e3> 3 </e3> </d2>第五步取得
<e1> </e1> 1 <e2> 2 </e2>
<e3> 3 </e3>第六步取得
1 2 3
-------------
标签都是变量
以上根据实际情况可能有十几步才能取出最终我想要的结果水能根据上述数据结构构造出程序。

Answer 3

随便写了个.你可以根据自己的需求来更改一下.怎么取的正确,除了程序还外有规则是否准确.
Dim strA As String, strTmp As String
    Dim arrSplit1(4) As String
    Dim arrSplit2(4) As String
    Dim i As Integer, intA As Integer, intB As Integer
    
    strA = "xxxx<a>a<a1><1>1</1><2>2</2></a1><a2>a2</a2></a>xxxxxxxxx"
    
    strTmp = strA    arrSplit1(0) = "<a>"
    arrSplit2(0) = "</a>"
    
    arrSplit1(1) = "<1>"
    arrSplit2(1) = "</1>"
    
    arrSplit1(2) = "<2>"
    arrSplit2(2) = "</2>"
    
    arrSplit1(3) = "<a1>"
    arrSplit2(3) = "</a1>"
    
    arrSplit1(4) = "<a2>"
    arrSplit2(4) = "</a2>"
    
    '每次取得标签中的字符
    For i = 0 To UBound(arrSplit1)
        Do While InStr(strTmp, arrSplit1(i)) > 0
            intA = InStr(strTmp, arrSplit1(i)) + Len(arrSplit1(i))
            intB = InStr(strTmp, arrSplit2(i))
            
            '取得标签之外的字符就用替换方式
            strTmp = Replace(strTmp, arrSplit1(i), "")
            strTmp = Replace(strTmp, arrSplit2(i), "")
            
            '如果是取得标签之内的字符就用如下方式
            'strTmp = Mid(strTmp, intA, intB - intA)
            
            Debug.Print strTmp & vbCrLf
            
        Loop
    Next