最近又要小爬一下动态网页,于是复习了一下常用对象。
Sub WebCrawler(ByRef Item, ByRef DraftPage)
Dim sKey As String
Dim k As Integer
sKey = "Time In Source Status"
k = 0
Dim GUrl As String
GUrl = "https://msjira.ooo.com/browse/" & Item
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate GUrl
Do Until .readyState = 4 'Complete
DoEvents
Loop
If (.document.querySelectorAll("div.aui-group aui-group-split").Length > 0) Then
Do Until (.document.querySelectorAll("div.wrap").Length > 0)
WaitToIEReady IE
Loop
GoTo Content
End If
On Error GoTo Content
.document.getElementById("login-form-username").Value = "yiyi"
.document.getElementById("login-form-password").Value = "yaya"
.document.getElementById("login-form-submit").Click
Do Until .readyState = 4 'Complete
DoEvents
Loop
Do Until (.document.querySelectorAll("div.wrap").Length > 0)
WaitToIEReady IE
Loop
Content:
.document.getElementById("all-tabpanel").Click
Do Until (.document.querySelectorAll("div.actionContainer").Length > 0)
WaitToIEReady IE
Loop
Do While k < 1000: 'Favorite part
Set tables = .document.getElementsBytagname("table")
k = k + 1
For Each tabl In tables
For Each oRow In tabl.Rows
For Each oCell In oRow.Cells
If Trim(oCell.innertext) = sKey Then GoTo CopyWork
Next
Next
Next
If k = 999 Then MsgBox "cannot find page": Exit Sub
Loop
CopyWork:
'Don't forget to close IE Clipboard warning in IE Option->SecurityTab->Custom Level->Scripting session
.document.execCommand "SelectAll"
.document.execCommand "copy"
'Paste all to put the webpage content
DraftPage.Range("A1").Select
Application.ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
End With
IE.Quit
End Sub
Sub WaitToIEReady(ByRef IeObj)
Do While IeObj.Busy
DoEvents
Loop
End Sub
继续增加一点,2017-12-07:这次用xmldom
'URL of XII
strURL = "http://xii.danager.com/xii.portfolio/main/getData.aspx?entityType=Portfolio.PortfolioXml&entityId=" & ws.Cells(1, 2).Value & "&effectiveDate=" & ws.Cells(2, 2) & "&internalteam=true"
Set xmlDom = CreateObject("Microsoft.XMLDOM")
'Set xmlDom = CreateObject("MSXML2.DOMDocument")
xmlDom.Load (strURL)
Do Until xmlDom.readystate = 4
DoEvents
Loop
Set holdNodes = xmlDom.SelectNodes("/Portfolio/Holding/HoldingDetail")
'Confirm holding number
If holdNodes.Length < 1 Then
MsgBox "empty portfolio in xml"
Exit Sub
End If
'Start to fill detail value into HoldingSheet
Osht.UsedRange.Clear
Osht.Cells(1, 1).Value = "PortfolioDate"
Osht.Cells(1, 2).Value = "SecurityName"
Osht.Cells(1, 3).Value = "DTID"
Osht.Cells(1, 4).Value = "MatchingTypeCode"
Osht.Cells(1, 5).Value = "LessThan92"
Osht.Cells(1, 6).Value = "CUSIP"
Osht.Cells(1, 7).Value = "Share"
Osht.Cells(1, 8).Value = "MarketValue"
Osht.Cells(1, 9).Value = "SecId"
Osht.Cells(1, 10).Value = "LocalCurrencyCode"
For i = 0 To holdNodes.Length - 1
Set SecurityName = holdNodes(i).SelectSingleNode("SecurityName")
Set dtidType = holdNodes(i).Attributes.getNamedItem("_DetailHoldingTypeId")
Set matchingType = holdNodes(i).SelectSingleNode("MatchingTypeCodeId")
Set lessThan92 = holdNodes(i).SelectSingleNode("LessThan92DaysBond")
Set CUSIP_no = holdNodes(i).SelectSingleNode("CUSIP")
Set marketValue = holdNodes(i).SelectSingleNode("MarketValue")
Set shareNumber = holdNodes(i).SelectSingleNode("NumberOfShare")
Set secId = holdNodes(i).Attributes.getNamedItem("_Id")
Set localCur = holdNodes(i).SelectSingleNode("LocalCurrencyCode")