プロが教える店舗&オフィスのセキュリティ対策術

Excel2003のVBAでMSXML2.DomDocumentを使ってXMLの処理をしています。http経由でXMLを取得し、パースして、Sheetに書き込んでいます。

XMLの行数が少ないうちは問題ないのですが、行数が1600件を超えたあたりで、LoadXML()メソッドで落ちます。

XMLを分割して、500行ずつや100行ずつLoadXMLさせても、合計処理数が1600行あたりで、必ずLoadXML()に失敗します。
メモリ不足かと思って、ループするごごとにSet Dom = Nothingのようにしてオブジェクトをクリアしていますが、効果がありません。

処理させたいXMLは最大で8000行になります。

なんとか解決策はないでしょうか?
以下、ソースの一部です。

Dim Dom As New MSXML2.DOMDocument

Function get_xml_dom(query)
Dim MSX As Object
Set Dom = New MSXML2.DOMDocument

Dim Url As String

host_address = "hostname"

host_path = "/keyword_report/get_keyword_data"
Url = "http://" & host_address & host_path & query

Set MSX = CreateObject("MSXML2.XMLHTTP")
MSX.Open "GET", Url, False
MSX.Send

If Dom.LoadXML(MSX.responseText) Then '<- 1600件ぐらい処理させるとここで落ちる
Debug.Print "Load XML is True"
get_xml_dom = True
Else
get_xml_dom = False
Debug.Print "Load XML is False"
End If

Set MSX = Nothing
End Function

このあと、DomからXPATHで要素を取り出して、シートに埋め込んでいます。

A 回答 (5件)

連続回答します。


逆にMSXML2.XMLHTTPをつかわづ直接MSXML2.DOMDocumentで読み込むのも出来るとおもうのですが...
下のプログラムだとちゃんとURLでHTTPリクエストしてくれてます。
Sub gettag()
Dim result As String
Dim ObjXml As MSXML2.DOMDocument
Dim nlist As MSXML2.IXMLDOMNodeList
Set ObjXml = CreateObject("MSXML2.DOMDocument")
ObjXml.async = False
If ObjXml.Load("http://xxxx/xx.xml") = True Then
Set nlist = ObjXml.selectNodes("//情報/大問[@形式=""1""]/*")
Call Get_Node(nlist, result)
Debug.Print result
MsgBox result
Cells(1, 1).Value = result
End If
End Sub
Sub Get_Node(ByRef Nodes As MSXML2.IXMLDOMNodeList, _
ByRef result As String)
Dim xNode As MSXML2.IXMLDOMNode
For Each xNode In Nodes
If xNode.nodeType = NODE_TEXT Then
result = result + xNode.nodeValue
End If
If xNode.hasChildNodes Then
result = result + "<" + xNode.nodeName + ">"
Call Get_Node(xNode.childNodes, result)
result = result + "</" + xNode.nodeName + ">"
End If
Next xNode
End Sub
    • good
    • 0

yyr446です。


Set MSX = CreateObject("MSXML2.XMLHTTP")を
Set MSX = CreateObject("MSXML2.ServerXMLHTTP")
If MSX Is Nothing Then Set MSX = CreateObject("MSXML2.ServerXMLHTTP.4.0")
If MSX Is Nothing Then Set MSX = CreateObject("WinHttp.WinHttpRequest.5.1")
If MSX Is Nothing Then Set MSX = CreateObject("MSXML2.XMLHTTP")
If MSX Is Nothing Then Set MSX = CreateObject("Microsoft.XMLHTTP")
にして試して見てください。
(全部使えなかったりして....)
    • good
    • 0

Dom.LoadXML(MSX.responseText)


で、xml=text=>xmlで文字コードか何かの影響でxmlが壊れてしまう箇所が
あるのでは、
Dim Dom As New MSXML2.DOMDocument
は止めて、Dim Dom As Object
Dom = MSX.responseXML
とするだけで、だいじょうぶなはず。(Msxml2.XMLHTTP.3.0以上の場合)
    • good
    • 0
この回答へのお礼

おお! と思って試したんですが、

MSX.responseXMLというメソッドはサポートされていないと
怒られます。

>(Msxml2.XMLHTTP.3.0以上の場合)

参照設定でMicosoft XML v6.0を使用しております。

お礼日時:2009/09/18 17:27

XMLの方に問題がある可能性はありませんか?



異なるアプローチで試しても同じデータ箇所でエラーが出るのであれば、処理よりもデータを疑ってみるといいかもしれません。

Excelが吐く「メモリ不足エラー」が本当にメモリ不足だった経験がない。はずれてたら見なかったことに・・・。

この回答への補足

なるほど!
データを調べてみます。

補足日時:2009/09/18 17:28
    • good
    • 0

無責任な思いつき案ですが



Option Explicit
Dim Dom As MSXML2.DOMDocument
Dim MSX As MSXML2.XMLHTTP '"Microsoft XML, v?.?"に参照設定してるのですよね?

Sub try()
  Dim i As Long
  Dim query
  
  Set Dom = New MSXML2.DOMDocument
  Set MSX = New MSXML2.XMLHTTP
  For i = 1 To 8000
    query = "hoge" & i
    If get_xml_dom(query) Then
      ':
    End If
  Next
  
  Set Dom = Nothing
  Set MSX = Nothing
End Sub

こんな感じでモジュールレベル変数にしてLoopの外でSetして使い回してみてもダメでしょうか。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!