vba爬动态网页

原贴地址：https://blog.csdn.net/u011410413/article/details/54629770
vba执行js：http://club.excelhome.net/thread-1303169-1-1.html
代码会打开IE浏览器逐步操作，和使用python selenium的效果一样。没有找到更换浏览器的方法。
‘’'my test is over here以下的代码全部未测试

Sub aa()
    url = "http://club.excelhome.net/thread-1466658-1-1.html?tdsourcetag=s_pcqq_aiomsg"
    Call WebCrawler(url, Empty)
End Sub

Sub WebCrawler(ByVal GUrl, ByRef DraftPage)

	Dim sKey As String
	Dim k As Integer

    sKey = "Time In Source Status"
    k = 0


	Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")

    With IE

            .Visible = True
            .navigate GUrl
            Do Until .readystate = 4  'Complete
                    DoEvents
            Loop
            
            Set ele = .document.querySelector(".fastlg_l button em")
		    Set oWindow = .document.parentWindow
		    '''can execute javascript code,alert will block,after click ok vba code goes on
		    oWindow.execScript "var t=3;alert(t);"              
		    t = oWindow.t
            'ele.Value = "fa xin tie value"
            ele.innerhtml = "fa xin tie innerhtml"
            ele.Click			
            IE.Quit				'''my test is over here
            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