4

Dom ドキュメントのルート ノードをインスタンス化しようとしています。ただし、名前を付けてxbrlいますが、この名前はデフォルトの名前空間にあります。xmlns="http://www.xbrl.org/2003/instance"

以前の投稿回答によると、 MSXML はデフォルトの名前空間に関してはバグがあります (barrowc の回答) 。そのため、コードにいくつかの変更を加える必要がありました。これらの場所

objXMLDoc.LoadXML (objXMLHTTP.responseText)

と取り換える

objXMLDoc.LoadXML objXMLHTTP.responseText
objXMLDoc.setProperty "SelectionNamespaces", "xmlns:r='http://www.xbrl.org/2003/instance'"

そしてまた

Dim objXMLHTTP As New MSXML2.XMLHTTP
Dim objXMLDoc As New MSXML2.DOMDocument

で置き換える

Dim objXMLHTTP As New MSXML2.XMLHTTP60
Dim objXMLDoc As New MSXML2.DOMDocument60

番号60はバージョン 6.0 を表します

したがって、これらの変更を行ったとき、マクロはエラーなしで機能しました。しかし、今では時々しか機能しません。そうでないときは、

Run-time error -2147467259(80004005)':

Reference to undeclared namespace prefix:'us-gaap.'

マクロがクラッシュする理由がわかりません 。これはバグだと思います。

手伝ってくれますか？

完全を期すために、マクロ全体を以下に提出します

Sub READSITE()

    Dim IE As InternetExplorer
    Dim els, el, colDocLinks As New Collection
    Dim lnk, res
    Dim Ticker As String
    Dim colXMLPaths As New Collection
    Dim XMLElement As String

    Set IE = New InternetExplorer

    IE.Visible = False

    Ticker = Worksheets("Sheet1").Range("A1").Value

    LoadPage IE, "https://www.sec.gov/cgi-bin/browse-edgar?" & _
                  "action=getcompany&CIK=" & Ticker & "&type=10-Q" & _
                  "&dateb=&owner=exclude&count=20"

    Set els = IE.Document.getelementsbytagname("a")
    For Each el In els
        If Trim(el.innertext) = "Documents" Then
            colDocLinks.Add el.href
        End If
    Next el

    For Each lnk In colDocLinks
        LoadPage IE, CStr(lnk)
        For Each el In IE.Document.getelementsbytagname("a")
            If el.href Like "*[0-9].xml" Then
                Debug.Print el.innertext, el.href
                colXMLPaths.Add el.href
            End If
        Next el
    Next lnk

    XMLElement = Range("C1").Value

    'For each link, open the URL and display the Debt Instrument Insterest Rate
    For Each lnk In colXMLPaths
        res = GetData(CStr(lnk), XMLElement)
        With Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            .NumberFormat = "@"
            .Value = Ticker
            .Offset(0, 1).Value = lnk
            .Offset(0, 2).Value = res
        End With
    Next lnk

End Sub

Function GetData(sURL As String, sXMLElement As String)
    Dim strXMLSite As String
    Dim objXMLHTTP As New MSXML2.XMLHTTP60
    Dim objXMLDoc As New MSXML2.DOMDocument60
    Dim objXMLNodexbrl As MSXML2.IXMLDOMNode
    Dim objXMLNodeElement As MSXML2.IXMLDOMNode
    Dim objXMLNodeStkhldEq As MSXML2.IXMLDOMNode

    GetData = "?" 'No data from XML
    objXMLHTTP.Open "GET", sURL, False  '<<EDIT: GET the site
    objXMLHTTP.send
    objXMLDoc.LoadXML (objXMLHTTP.responseText)
    objXMLDoc.setProperty "SelectionNamespaces", "xmlns:r='http://www.xbrl.org/2003/instance'"

    Set objXMLNodexbrl = objXMLDoc.SelectSingleNode("r:xbrl")

    Set objXMLNodeElement = objXMLNodexbrl.SelectSingleNode(sXMLElement)

    If Not objXMLNodeElement Is Nothing Then
        GetData = objXMLNodeElement.Text
    End If
End Function

Sub LoadPage(IE As Object, url As String)
    IE.Navigate url
    Do While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
End Sub

barrowc から与えられた変更に従って修正前の状態でマクロを変更すると、マクロが機能することがわかります。

4

1 に答える 1

1

私が持っていた以前のコード サンプルで膨大なコードをDiff Checkerでチェックすることで、バグを迅速に解決することができました。必要なのは、これらの行からを削除することだけのようです60(神はその理由を知っています...)

Dim objXMLHTTP As New MSXML2.XMLHTTP60
Dim objXMLDoc As New MSXML2.DOMDocument60
于 2014-03-03T22:19:11.137 に答える