Public Function ImportNetT(ByVal strNetT As String, ByRef TopicId As String) As Boolean
On Error GoTo Error_ImportNetT
ImportNetT = False
Set xmldoc = New DOMDocument
xmldoc.async = False
'XMLDoc.validateOnParse = False
'If validation is not important, skip it
xmldoc.Load strNetT
If xmldoc.parseError.errorCode = 0 Then
If xmldoc.readyState = 4 Then
If ConstructXMLRS(xmldoc, TopicId) = False Then GoTo Error_ImportNetT
End If
Else
GoTo Error_ImportNetT
' MsgBox xmldoc.parseError.reason & vbCrLf & _
' xmldoc.parseError.Line & vbCrLf & _
' xmldoc.parseError.srcText
End If
ImportNetT = True
Exit Function
Error_ImportNetT:
ImportNetT = False
End Function
'导入数据
Public Function ConstructXMLRS(XMLFile As DOMDocument, ByRef TopicId As String) As Boolean
Dim XMLRoot As IXMLDOMElement
Dim XMLNode As IXMLDOMNode
Dim XMLChildNode As IXMLDOMNode
Dim XMLCurChildNode As IXMLDOMNode
Dim strSQL As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
On Error GoTo Error_ConstructXMLRS
ConstructXMLRS = False
Set XMLNode = XMLRoot.selectSingleNode("Issue")
On Error Resume Next
rs.Open "Select * From Topics", conn, adOpenDynamic, adLockOptimistic, adCmdText
rs.AddNew
For Each XMLChildNode In XMLNode.childNodes
rs.Fields(XMLChildNode.nodeName).Value = XMLChildNode.Text
If XMLChildNode.nodeName = "TopicId" Then TopicId = XMLChildNode.Text
Next
rs.Fields("ReplyDateTime").Value = Now
rs.Update
rs.Close
rs.Open "Select * From Replys", conn, adOpenDynamic, adLockOptimistic, adCmdText
Set XMLNode = XMLRoot.selectSingleNode("Replys")
For Each XMLChildNode In XMLNode.childNodes
rs.AddNew
For Each XMLCurChildNode In XMLChildNode.childNodes
rs.Fields(XMLCurChildNode.nodeName).Value = XMLCurChildNode.Text
Next
rs.Update
Next
rs.Close
Set rs = Nothing
Set conn = Nothing
ConstructXMLRS = True
Exit Function
Error_ConstructXMLRS:
Set rs = Nothing
Set conn = Nothing
ConstructXMLRS = False
End Function