7,785
社区成员




'排序代码(这个是投机取巧的方法,要引用“Microsoft AetiveX Date Objects 2.x Library”)
'参数s是个数组
'返回一个排好序的数组
Private Function GetSort(s() As String) As String()
Dim tmp As String
Dim rst As Recordset
Set rst = New Recordset
With rst
.fields.Append "Fld", adVarChar, 10
.open
For i = LBound(s) To UBound(s)
.AddNew
!Fld = s(i)
.Update
Next
.Sort = "Fld"
tmp = .GetString
.Close
End With
Set rst = Nothing
GetSort = Split(tmp, Chr(13))
End Function
'
Private Sub Command1_Click()
Dim oXmlDoc As DOMDocument
Dim oXmlNode As IXMLDOMNode
Dim oXmlNodes As IXMLDOMNodeList
Dim FileName As String
Dim sFile As String
Dim sSortValue() As String
Dim tmp() As String
Dim i As Long, h As Long
FileName = App.Path & "\tt.xml"
'读出要排序的内容到数组sSortValue
ReDim sSortValue(i)
Set oXmlDoc = New DOMDocument
oXmlDoc.Load (FileName)
Set oXmlNodes = oXmlDoc.documentElement.selectNodes(".//班级")
For Each oXmlNode In oXmlNodes
ReDim Preserve sSortValue(i)
sSortValue(i) = oXmlNode.Attributes(0).Text
i = i + 1
Next
Set oXmlNode = Nothing
Set oXmlNodes = Nothing
Set oXmlDoc = Nothing
'排序
sSortValue = GetSort(sSortValue)
'将xml整体读出到变量sFile
h = FreeFile
Open FileName For Binary As h
sFile = Space(LOF(h))
Get h, , sFile
Close h
'对整体内容分组处理
sFile = Replace(sFile, Chr(0), "")
tmp = Split(sFile, "/班级")
'分组后的内容分别与排序内容对比,重新串接字串
sFile = ""
i = 0
While i < UBound(sSortValue)
sFile = sFile & Filter(tmp, sSortValue(i), True)(0) & "/班级"
i = i + 1
Wend
sFile = sFile & tmp(UBound(tmp))
'写回xml
h = FreeFile
Open App.Path & "\sort_tt.xml" For Output As h
Print #h, sFile
Close
End Sub