使用VBA提取XML属性

Question

我不是一名开发人员，拥有非常有限的XML知识，但是我学到了过去3 - 4天在Web上进行的研究。所以提前对这个问题的基本层面表示歉意。我正试图结束这一次的任务。

我有一些VBA Excel知识，目前我正尝试使用VBA从SEC文件网站上的给定公司页面提取SIC代码属性。作为一个例子，这是网站沃尔玛

http://www.sec.gov/cgi-bin/browse-edgar?action=getcompany&CIK=0000104169&owner=exclude&count=40&hidefilings=0

在你可以看到顶部的蓝色条“SIC：5331”这是在5331我试图返回到VBA变量，这样我可以填充电子表格。当我在IE和陈词滥调查看源文件右键单击页面的一部分是相关的XML全文：

<div id="contentDiv"> 
    <!-- START FILER DIV --> 
    <div style="margin: 15px 0 10px 0; padding: 3px; overflow: hidden; background-color: #BCD6F8;"> 
    <div class="mailer">Mailing Address 
     <span class="mailerAddress">702 SOUTHWEST 8TH STREET</span> 
     <span class="mailerAddress"> BENTONVILLE AR 72716   </span> 
    </div> 
    <div class="mailer">Business Address 
     <span class="mailerAddress">702 SOUTHWEST 8TH ST</span> 
     <span class="mailerAddress">BENTONVILLE AR 72716   </span> 
     <span class="mailerAddress">5012734000</span> 
    </div> 
    <div class="companyInfo"> 
     <span class="companyName">WAL MART STORES INC <acronym title="Central Index Key">CIK</acronym>#: <a href="/cgi-bin/browse-edgar?action=getcompany&amp;CIK=0000104169&amp;owner=exclude&amp;count=40">0000104169 (see all company filings)</a></span> 
     <p class="identInfo"><acronym title="Standard Industrial Code">SIC</acronym>: <a href="/cgi-bin/browse-edgar?action=getcompany&amp;SIC=5331&amp;owner=exclude&amp;count=40">5331</a> - RETAIL-VARIETY STORES<br />State location: <a href="/cgi-bin/browse-edgar?action=getcompany&amp;State=AR&amp;owner=exclude&amp;count=40">AR</a> | State of Inc.: <strong>DE</strong> | Fiscal Year End: 0131<br />(Assistant Director Office: 2)<br />Get <a href="/cgi-bin/own-disp?action=getissuer&amp;CIK=0000104169"><b>insider transactions</b></a> for this <b> issuer</b>. 
     <br />Get <a href="/cgi-bin/own-disp?action=getowner&amp;CIK=0000104169"><b>insider transactions</b></a> for this <b>reporting owner</b>. 
     </p> 
    </div> 
    </div> 
</div> 

在试图理解VBA如何可能被用来提取SIC，我发现下面的职位上您的网站：

Query and parse xml attribute value into XLS using VBA

我试图复制应用barrowc的答案/粘贴到Excel工作模块插入路径沃尔玛申请但是当我步我得到Debug.Print“*** **“但我没有得到任何n.Text的东西。

Sub test4() 
    Dim d As MSXML2.DOMDocument60 
    Dim i As IXMLDOMNodeList 
    Dim n As IXMLDOMNode 

    Set d = New MSXML2.DOMDocument60 
    d.async = False 
    d.Load ("http://www.sec.gov/cgi-bin/browse-edgar?company=&match=&CIK=886475&filenum=&State=&Country=&SIC=&owner=exclude&Find=Find+Companies&action=getcompany") 

    Debug.Print "*****" 
    Set i = d.SelectNodes("//div[@id='contentDiv']") 
    For Each n In i 
     Debug.Print n.Text 
    Next n 
    Debug.Print "*****" 

    Set d = Nothing 
End Sub 

我已经试过各种字符串d.SelectNodes()，但我不知道有足够的了解这个话题明白我要去哪里错了。因此，对我的语法或对资源的指针的评论将非常有用。

Answer 1

如果您只对SIC感兴趣，那么尝试解析整个DOM结构并不值得花时间。相反，识别一组独特的字符，搜索该字符，然后从那里提取SIC。

以下功能就是这样做的。你只需要通过它的页面的完整HTML源，它将返回SIC：

Function ExtractSIC(SourceHtml As String) As String 
    Const PrefixChars As String = "&SIC=" 
    Const SuffixChars As String = "&" 
    Dim StartPos As Long, EndPos As Long 
    StartPos = InStr(SourceHtml, PrefixChars) 
    If StartPos = 0 Then Exit Function 

    StartPos = StartPos + Len(PrefixChars) 
    EndPos = InStr(StartPos, SourceHtml, SuffixChars) - 1 
    ExtractSIC = Mid(SourceHtml, StartPos, EndPos - StartPos + 1) 
End Function 

Answer 2

再次感谢mwolfe。我已经在下面发布了我的代码，但是您提供的代码更优雅。我知道SIC只有4位数，所以我很懒惰，并且在代码中做了一个假设，并且可能会在将来抛出错误。你可以在注释部分看到我是如何做到的。

Sub GetSICs() 
    Application.ScreenUpdating = False 

    Dim AWBN As String 
    Dim ASN As String 
    Dim CIK As String 
    Dim NUM_FILES_TO_GET As Long 
    Dim COUNTER As Long 
    Dim SICTagPos As Integer 
    Dim SIC As String 

    Set IEbrowser = CreateObject("InternetExplorer.application") 
    IEbrowser.Visible = False 
    AWBN = ActiveWorkbook.Name 
    ASN = ActiveSheet.Name 
    Workbooks(AWBN).Sheets(ASN).Range("A1").Select 
    ActiveCell.Offset(0, 11) = "SIC" 
    NUM_FILES_TO_GET = Application.WorksheetFunction.CountA(Range("A:A")) 
    For COUNTER = 1 To 3 'NUM_FILES_TO_GET 
     Application.StatusBar = "Counter = " & COUNTER 
     'SICTagPos = 0 
     CIK = ActiveCell.Offset(COUNTER, 2) 
     IEbrowser.Navigate URL:="http://www.sec.gov/edgar/searchedgar/companysearch.html" 
     Do 
      DoEvents 
     Loop Until IEbrowser.readyState = 4 
     Set frm = IEbrowser.Document.forms(0) 
     frm("CIK").Value = CIK 
     frm.submit 
     While IEbrowser.Busy Or IEbrowser.readyState <> 4: DoEvents: Wend 
     SIC = ExtractSIC(IEbrowser.Document.body.innerhtml) 
     'SICTagPos = InStr(1, IEbrowser.Document.body.innerhtml, "SIC=") 
     'SIC = Right(Left(IEbrowser.Document.body.innerhtml, SICTagPos + 7), 4) 
     ActiveCell.Offset(COUNTER, 11).NumberFormat = "@" 
     ActiveCell.Offset(COUNTER, 11) = SIC 

    Next 

    Application.StatusBar = False 
    Application.ScreenUpdating = True 

End Sub 


Function ExtractSIC(SourceHtml As String) As String 
    Const PrefixChars As String = "&amp;SIC=" 
    Const SuffixChars As String = "&" 
    Dim StartPos As Long, EndPos As Long 
    StartPos = InStr(SourceHtml, PrefixChars) 
    If StartPos = 0 Then Exit Function 

    StartPos = StartPos + Len(PrefixChars) 
    EndPos = InStr(StartPos, SourceHtml, SuffixChars) - 1 
    ExtractSIC = Mid(SourceHtml, StartPos, EndPos - StartPos + 1) 
End Function