|
|
本帖最后由 lms008 于 2018-3-20 15:27 编辑
向老师请教@liu-aguang, 在采集数据中，返回的数据是类似XML格式的数据，数据在附件中：
问题：
我需要解析里面多条记录的数据，取出对应的字段。
1):保存到xml 文件代码如下:
Sub makeXml(inputed_string As String, log_path As String, fileName As String)
Dim objFSO, logfile, logtext, log_folder, log_Newpath
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
log_Newpath = log_path & "\responseData"
Set log_folder = objFSO.CreateFolder(log_Newpath)
If objFSO.FileExists(log_Newpath & "\" & fileName) = 0 Then
Set logfile = objFSO.CreateTextFile(log_Newpath & "\" & fileName, True, -1)
End If
Set log_folder = Nothing
Set logfile = Nothing
Set logtext = objFSO.OpenTextFile(log_Newpath & "\" & fileName, 2, True, -1)
logtext.Write "<?xml version=""1.0"" encoding=""UTF-8""?>"
logtext.Write inputed_string
logtext.Close
Set objFSO = Nothing
End Sub
我想把这些数据保存在一个xml文件中，
2):在用dom来读取xml格式的数据：代码简单如下：
Function ParseXMLData()
Dim strXMLPath As String
Dim xmlDoc, rcdSetList, recordTmp, row_list, row_files, nodes
Dim strAppID, strPrd, strCustNam, strCmpCde, strAppStatus, strPrsStatus, strQueStatus, strAppDte, strDrwaDate, strPendStatusFlag
Dim i As Integer
On Error GoTo errHandler
'strXMLPath = ThisWorkbook.Path & "\responseData\data_search_result.xml"
strXMLPath = "D:\H\2015_CR_SIRS\VBA\RDF_EUC_PCL&Porfolios\CSIM_user_blacklist_TUEF_AC\Login_COS_CSIM\COS_testing_20180319\cos" & "\data_search_result2.xml"
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = "false"
If Not IsEmpty(Worksheets("COS_Search_data").Activate) Then ActiveSheet.UsedRange.ClearContents
ActiveSheet.[a1:j1] = Array("Application ID", "Anchor product", "Customer Name", "Campaign Code", "Application status", "Process status", "Queue Status", "Application date", "Draw down date", "Pending Application Flag")
xmlDoc.Load (strXMLPath)
Set rcdSetList = xmlDoc.SelectNodes("lov/recordSet")
For Each recordTmp In rcdSetList
Set row_list = recordTmp.SelectNodes("content/row")
i = 1
For Each row_files In row_list
i = i + 1
'Debug.Print row_files.Attributes(0).Text
strAppID = row_files.ChildNodes(1).ChildNodes(0).NodeValue
strPrd = row_files.ChildNodes(2).ChildNodes(0).NodeValue
strCustNam = row_files.ChildNodes(3).ChildNodes(0).NodeValue
strCmpCde = row_files.ChildNodes(7).ChildNodes(0).NodeValue
strAppStatus = row_files.ChildNodes(5).ChildNodes(0).NodeValue
strPrsStatus = row_files.ChildNodes(16).ChildNodes(0).NodeValue
strQueStatus = row_files.ChildNodes(17).ChildNodes(0).NodeValue
strAppDte = row_files.ChildNodes(18).ChildNodes(0).NodeValue
' strDrwaDate = row_files.ChildNodes(19).ChildNodes(0).NodeValue
Cells(i, 1) = strAppID
Cells(i, 2) = strPrd
Cells(i, 3) = strCustNam
Cells(i, 4) = strCmpCde
Cells(i, 5) = strAppStatus
Cells(i, 6) = strPrsStatus
Cells(i, 7) = strQueStatus
Cells(i, 8) = strAppDte
Cells(i, 9) = strDrwaDate
'Add logic for Pending Appliction flag.
'for Pending Appliction = No
'if Application Status = ACCEPTED & Process Status =COMPLETED OR
'Application Status = CANCELLED OR Application Status = DECLINED OR No Application
'Else Pending Appliction = Yes
If strAppStatus = "" Then
strPendStatusFlag = "NO"
ElseIf strAppStatus = "ACCEPTED" & strPrsStatus = "COMPLETED" Then
strPendStatusFlag = "NO"
ElseIf strAppStatus = "CANCELLED" Then
strPendStatusFlag = "NO"
ElseIf strAppStatus = "DECLINED" Then
strPendStatusFlag = "NO"
Else
strPendStatusFlag = "YES"
End If
Cells(i, 10) = strPendStatusFlag
Next
Next
Columns("H:H").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
Application.ScreenUpdating = True
ActiveSheet.[A:I].Columns.AutoFit
ParseXMLData = True
Exit Function
errHandler:
MsgBox Err.Number & vbTab & Err.Description, vbCritical + vbOKOnly, "Parse XML Data Failed"
ActiveWorkbook.Sheets("log").Activate
ActiveSheet.Cells(8, 2) = Trim(Err.Description) & "::" & Replace(Err.Number, "-", "")
ParseXMLData = False
Exit Function
End Function
附近如下:
单是行数那行就有问题，导致数据不能解析出来。
想请教老师，如何可以把response data （附件的数据）保存到一个xml 文档中？ 或者其它方法可以快速的解析出我想要的数据
|
|
楼主: liu-aguang
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2017-10-9 22:09
楼主
