此处我们有Codo提供给Mr Tim Williams的程序,该程序打印在Immediate window
我们真正想要的东西上。我从original copy进行了一些小修改,我旁边有评论词MODIFICATION
Sub MAGAZINE()
Dim IE As InternetExplorer ' MODIFICATION
Dim els, el, colDocLinks As New Collection
Dim lnk
Dim Ticker As String ' MODIFICATION
Set IE = New InternetExplorer 'MODIFICATION
IE.Visible = True
Ticker = Worksheets("Sheet1").Range("A1").Value 'MODIFICATION
loadpage IE, "https://www.sec.gov/cgi-bin/browse-edgar?" & _
"action=getcompany&CIK=" & Ticker & "&type=10-Q" & _ 'MODIFICATION by putting the Ticker String Variable and then Concatenate accordingly
"&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 'MODIFICATION
Debug.Print el.innertext, el.href
End If
Next el
Next lnk
End Sub
Sub loadpage(IE As Object, url As String)
IE.Navigate url
Do While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
End Sub
您可以在第四次修改/添加中注意到,一个人只需在单元格A1上键入股票代码并触发代码
Ticker = Worksheets("Sheet1").Range("A1").Value 'MODIFICATION
现在的问题是,如果我们使用不同的股票代码,我们会在立即窗口上打印不同的行数。
例如,通过在单元格A1中键入股票代码CRR,我们得到11个结果
现在,如果我们在单元格A1中键入自动收录机MSFT,我们得到14个结果
现在问题的关键是这些字符串值需要插入到RIFLE macro
中,虽然我可以确定我从字符串变量中的每个循环迭代得到的值,但是在我的脑海里抛出一个猴子扳手是MAGAZINE macro
因为逻辑没有在即时窗口上打印确切的行数。您可以看到实际上在前两张图片中......
那么当MAGAZINE macro
的结果为6行时怎么可能呢?这些被分配给6个字符串变量并且没有30个字符串变量总是被声明在内存中破坏并且结果是14行;这些将分配给14个字符串变量。
如何在运行时调整这一点,以便步枪总是加载正确的轮数?
因为我不会止步于此;那么我计划在user2140261提供的RIFLE macro
中插入这些字符串变量,如下所示......
Sub RIFLE()
Dim strXMLSite As String
Dim objXMLHTTP As MSXML2.XMLHTTP
Dim objXMLDoc As MSXML2.DOMDocument
Dim objXMLNodexbrl As MSXML2.IXMLDOMNode
Dim objXMLNodeDIIRSP As MSXML2.IXMLDOMNode
Set objXMLHTTP = New MSXML2.XMLHTTP
Set objXMLDoc = New MSXML2.DOMDocument
strXMLSite = "http://www.sec.gov/Archives/edgar/data/10795/000119312513456802/bdx-20130930.xml"
objXMLHTTP.Open "POST", strXMLSite, False
objXMLHTTP.send
objXMLDoc.LoadXML (objXMLHTTP.responseText)
Set objXMLNodexbrl = objXMLDoc.SelectSingleNode("xbrl")
Set objXMLNodeDIIRSP = objXMLNodexbrl.SelectSingleNode("us-gaap:DebtInstrumentInterestRateStatedPercentage")
Worksheets("Sheet1").Range("A1").Value = objXMLNodeDIIRSP.Text
End Sub
如果你可以将来自MAGAZINE宏的波动数量的字符串值插入到RIFLE宏中的字符串变量中,这将会影响整个问题。
此处的RIFLE宏具有strXMLSite
String Variabe的原始格式。
UPDATE 我目前正在尝试将其加载到数组中,然后将其卸载...
答案 0 :(得分:2)
这是一个建议:
Sub MAGAZINE()
Dim IE As InternetExplorer ' MODIFICATION
Dim els, el, colDocLinks As New Collection
Dim lnk, res
Dim Ticker As String ' MODIFICATION
Dim colXMLPaths As New Collection '<<<EDIT
Set IE = New InternetExplorer 'MODIFICATION
IE.Visible = True
Ticker = Worksheets("Sheet1").Range("A1").Value 'MODIFICATION
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 '<<<EDIT
End If
Next el
Next lnk
'EDIT: ADDED
For Each lnk In colXMLPaths
res = RIFLE(CStr(lnk))
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 RIFLE(sURL As String)
Dim strXMLSite As String
Dim objXMLHTTP As New MSXML2.XMLHTTP
Dim objXMLDoc As New MSXML2.DOMDocument
Dim objXMLNodexbrl As MSXML2.IXMLDOMNode
Dim objXMLNodeDIIRSP As MSXML2.IXMLDOMNode
RIFLE = "???"
objXMLHTTP.Open "GET", sURL, False '<<EDIT: GET not POST
objXMLHTTP.send
objXMLDoc.LoadXML (objXMLHTTP.responseText)
Set objXMLNodexbrl = objXMLDoc.SelectSingleNode("xbrl")
Set objXMLNodeDIIRSP = objXMLNodexbrl.SelectSingleNode _
("us-gaap:DebtInstrumentInterestRateStatedPercentage")
If Not objXMLNodeDIIRSP Is Nothing Then
RIFLE = objXMLNodeDIIRSP.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