楼主
嘉昆2011 |
问题描述：
对于游戏数据生成的*.pxml文件如何批量在Excel工作簿中更新？
对于常规的XML文件批量导入更新，可以利用Excel本身自带的XML映射功能完成，具体可以参考：
如何批量导入XML文件：
- http://www.exceltip.net/forum.php?mod=viewthread&tid=39327&fromuid=88828
对于非常规XML文件可以尝试以下几种方法：
1，XMLImport映射功能，参考K版的帖子：
如何利用vba代码批量导入xml文件信息？
- http://www.exceltip.net/forum.php?mod=viewthread&tid=26251&fromuid=21112
- Sub TestXMLImport()
- Dim N As Long, myFile As String, myPath As String, map As XmlMap
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Sheet2.[A1].CurrentRegion.Clear
- myPath = ThisWorkbook.Path & "\"
- myFile = Dir(myPath & "*.pxml")
- N = 1
- Do While myFile <> ""
- ThisWorkbook.XMLImport myPath & myFile, Nothing, False, Sheet2.Cells(N, 1)
- N = N + 1
- myFile = Dir
- Loop
- For Each map In ThisWorkbook.XmlMaps
- map.Delete
- Next map
- Sheet2.Range("A:B,D:F,H:N,Q:T,DI:FF").Delete
- Columns.AutoFit
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
该方法在批量导入.pxml文件时速度较慢，会出现假死现象。
2，创建XMLHTTP对象导入，参考弦月版主帖子：
使用XMLHTTP批量导入XML文件
- http://www.exceltip.net/forum.php?mod=viewthread&tid=26245&fromuid=30639
- Sub TestXMLHTTP()
- Dim tmp, i As Integer, XMLHTTP As Object, N As Long, myFile As String, myPath As String
-
- Application.ScreenUpdating = False
- Sheet3.[A1].CurrentRegion.Clear
- myPath = ThisWorkbook.Path & "\"
- myFile = Dir(myPath & "*.pxml")
- Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
- N = 1
- Do While myFile <> ""
-
- XMLHTTP.Open "GET", myPath & myFile, False
- XMLHTTP.send
- tmp = Split(Replace(XMLHTTP.responseText, """", ""), "Value=")
- For i = 1 To UBound(tmp)
- Sheet3.Cells(N, i) = Trim(Split(tmp(i - 1), "/>")(0))
- Next i
- Erase tmp
- N = N + 1
- myFile = Dir
- Loop
- Sheet3.Range("A:B,D:F,H:N,Q:T,DI:FF").Delete
- Set XMLHTTP = Nothing
- Application.ScreenUpdating = True
- Columns.AutoFit
- End Sub
该方法在批量导入.pxml文件时速度较快。
3，创建XMLDoc对象批量导入，参考书目：《Excel VBA与XML、 ASP协同应用》
- Sub TestLoadXMLDOC()
- Dim XMLDOC As MSXML2.DOMDocument30, tmp, N As Long, myFile As String, myPath As String
- Set XMLDOC = New MSXML2.DOMDocument30
- XMLDOC.async = False
- Sheet4.[A1].CurrentRegion.Clear
- myPath = ThisWorkbook.Path & "\"
- myFile = Dir(myPath & "*.pxml")
- N = 1
- Do While myFile <> ""
- If XMLDOC.Load(myPath & myFile) Then
- tmp = Split(Replace(XMLDOC.XML, """", ""), "Value=")
- For i = 1 To UBound(tmp)
- Sheet4.Cells(N, i) = Trim(Split(tmp(i - 1), "/>")(0))
- Next i
- Erase tmp
- End If
- N = N + 1
- myFile = Dir
- Loop
- Sheet4.Range("A:B,D:F,H:N,Q:T,DI:FF").Delete
- Set XMLDOC = Nothing
- Columns.AutoFit
- End Sub
该方法在批量导入.pxml文件时速度也十分快。
附件：
 Kaiserslautern.rar
|