VBA默认命名空间Bug

时间:2014-03-03 15:09:22

标签: excel vba excel-vba xbrl

我正在尝试实例化Dom文档的Root节点。但是,我将其命名为xbrl,此名称位于默认命名空间xmlns="http://www.xbrl.org/2003/instance"

根据previous post-answer MSXML is buggy (answer of 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给我的修正前状态according to the modifications中改变我的宏,我现在可以看到该宏工作了!

1 个答案:

答案 0 :(得分:1)

通过使用以前的代码示例检查Diff Checker庞大的代码,我能够迅速终止错误。你似乎只需从这些行中删除60(上帝知道为什么......)

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