天天看點

網頁爬蟲實踐——VBA調用JS事件

網頁爬蟲實踐——VBA調用JS事件

作者:AntoniotheFuture

關鍵詞:VBA,網頁爬蟲,網抓,JavaScript,Access

開發平台:Access

平台版本上限:2010

平台版本下限:尚未出現

開發語言:VBA

簡介:公司要求我們在雙12那天之前做一個可以實時調取系統背景新增保單并自動統計的程式,由于各方面的限制,該資料僅能從一個特定的網頁中擷取,該網頁是一個資訊查詢網頁,查詢結果以表格形式展示,且包含分頁導航按鈕,每次僅顯示上下五頁範圍的按鈕,簡單的網頁爬取方式不太适用。

實際上對于該任務,在公司的機構之間流傳着一個同樣是用VBA實作的程式,但該程式依靠EXCEL執行,每次循環點選頁面執行翻頁操作,且每次提取所有記錄,保單數量多時,執行效率較低,無法滿足公司要求,于是我需要重新設計該爬蟲程式(Access+VBA)

本程式可以判斷本地的保單資訊數量是否與網頁中的一緻,如果少了就繼續調取,相同則等待下一次執行,避免重複調取。

核心代碼如下:

Option Compare Database
Public breakornot      '用于檢測是否停止運作的全局變量

Private Sub Command2_Click()
'Code written by AntoniotheFuture at 2018-12-01
'Version:V1.0
'Function:爬取并儲存網頁上的保單清單。
'On Error GoTo delay

Dim dmt, elements, dmt1, a, tr, str, str3,recordnum, pagestr, pagenum, tailnum, startpage, startrecord, tailnum2, m,addnum
'str 頁面訓示   recordnum 系統記錄數    pagenum 系統頁數    tailnum 系統尾頁記錄數      startpage 已有頁數      startrecord 已有尾頁記錄
Dim loop1, loop2, loop3, loop4
Dim t1, t2
Dim Rs, Rs1, Rs4 As ADODB.Recordset
Dim STemp, STemp1 As String
Dim totalpage '總頁數

breakornot = 0    
Requery:                      '程式需要循環運作’
If breakornot = 1 Then
   Exit Sub
End If
 
keybd_event 19, 0, 0, 0             '防止螢幕鎖屏,此代碼需要寫一段特定的子產品,可百度“VBA防止鎖屏”
keybd_event 19, 0, &H2, 0

Set Rs1 = Nothing
Set Rs1 = New ADODB.Recordset

t1 = Time()    
Me.Text16 = "提取資料中"    '界面顯示狀态

'記錄運作狀态
STemp1 = "select * From 運作記錄"
Rs1.Open STemp1, CurrentProject.Connection,adOpenKeyset, adLockOptimistic
Rs1.AddNew
addnum = 0
Rs1("開始時間")= Date & " " & t1

'目标網頁已經在IE打開的前提下,轉移網頁控制權
Set dmt = Me.WebBrowser0.Object.Document
Set dmt1 = dmt.frames.rightFrame

'填寫網頁上的查詢表單
With dmt1.Document
   .getelementbyid("startDate").Value =Format("2017-12-7", "yyyy-mm-dd")  '預收時間段
   .getelementbyid("endDate").Value =Format("2017-12-8", "yyyy-mm-dd") '預收時間段
   .getelementbyid("regionCode").Value = "1"

    '執行網頁上的“onchange和onclick事件”
   .getelementbyid("regionCode").FireEvent "onchange"
   .getelementbyid("q_button").FireEvent "onclick"
End With

'點選查詢後網頁會有一定延遲,可根據實際情況增删語句
delay 8
Do While Me.WebBrowser0.Object.Busy = True             '‘等待網頁加載完畢’
   delay 0.5
   DoEvents
Loop

'再次判斷使用者是否要停止運作本程式
If breakornot = 1 Then
   Exit Sub
End If

delayout:
Set Rs = Nothing
Set Rs = New ADODB.Recordset
'讀取網頁查詢出來的資料
Set tr = dmt1.Document.getelementsbytagname("table")(4).Rows
STemp = "select * From 預收清單"
Rs.Open STemp, CurrentProject.Connection,adOpenKeyset, adLockOptimistic
   str = GetPageStr                 '‘擷取網頁中的記錄數目’
           If GetPageStr <> "" Then
                recordnum = CInt(Mid(str,InStr(str, "共") + 1, InStr(str, "條") - InStr(str, "共") - 1)) –2                            ‘網頁實際記錄數’
           End If
    
Me.Text16 = "導入資料中"

pagenum = Fix(recordnum / 50) + 1       '‘計算已有記錄換算的頁數(50條/頁)’
tailnum = recordnum Mod 50                   '‘計算已有記錄最後一頁的記錄數’

   If recordnum = 2 Then                      '‘如果當天還沒有單,網頁隻有兩條記錄,一條是空行,一條是記錄詳情,是以直接執行下一次提取。’
       GoTo Requery2
       Exit Sub
   ElseIf recordnum > Rs.RecordCount Then        '‘如果網頁記錄數大于已有的記錄數,就繼續
       startpage = Fix(Rs.RecordCount / 50) + 1         '‘開始提取的頁數’
       startrecord = Rs.RecordCount Mod 50 + 1       '‘當頁開始提取的第幾條記錄
       Rs.AddNew                                '‘初始化記錄
       For loop1 = startpage To pagenum          '‘從開始提取的頁到網頁總頁數’

           dmt1.Document.parentWindow.execScript "goToPage(" &startpage & ")"
'‘核心代碼,直接執行網頁中的js過程{gotopage},即翻頁’
           delay 0.5
           Do While Me.WebBrowser0.Object.Busy = True
                delay 0.5
                DoEvents
           Loop
           If startpage = pagenum Then  '‘如果開始頁是目前頁面,直接直接從第幾條開始提取,否則提取整個頁面的記錄(50)
                tailnum2 = tailnum
           Else
                tailnum2 = 50
           End If

    '寫入資料到資料庫
           For loop2 = startrecord To tailnum2
                Set tr =dmt1.Document.getelementsbytagname("table")(4).Rows
                Rs("業務代碼") = tr(loop2).Cells(4).innertext
                Rs("投保單号") = tr(loop2).Cells(8).innertext
                Rs("險種代碼") = tr(loop2).Cells(9).innertext
                Rs("保費") = tr(loop2).Cells(10).innertext
                Rs("錄入時間") = Format((tr(loop2).Cells(22).innertext), "GeneralDate")
                If tr(loop2).Cells(6).innertext<> " " Then
                     Rs("輔業務員") = tr(loop2).Cells(6).innertext
                End If
                If tr(loop2).Cells(26).innertext <> " " Then
                     Rs("指定生效日") = tr(loop2).Cells(26).innertext
                End If
                Rs.AddNew
                addnum = addnum + 1
           Next
           startrecord = 1
           startpage = startpage + 1
       Next
   Else                                    '‘如果系統記錄數等于網頁記錄數或其他情況,直接下個循環’
       GoTo Requery2
   End If
Rs1.MoveLast
Me.Text6.Requery
Me.Refresh
Requery2:
Me.Text16 = "等待下次重新整理"
m = 20                                      '‘根據設定的時間執行下次執行前的倒計時。’
For loop3 = 1 To 20
   If breakornot = 1 Then
   Exit Sub
   End If
    m= m - 1
   Me.Text12 = m
   'Me.Text12.Refresh
   delay 1
Next

'‘寫入運作情況記錄’
t2 = Time()
Rs1("運作時間(秒)")= DateDiff("s", t1, t2)
Rs1("增加條目數")= addnum
Rs1("總條目數")= DCount("業務代碼", "預收清單")
Rs1.MoveLast
Me.Text25 = Rs1("開始時間")
Me.Text28 = Rs1("運作時間(秒)")
Me.Text31 = Rs1("增加條目數")
Rs1.AddNew
GoTo Requery
delay:
delay 10
GoTo delayout
Exit Sub
Rs.Close
Set Rs = Nothing
Rs1.Close
Set Rs1 = Nothing
End Sub



Function GetPageStr()
   Dim str2 As String
   str2 = ""
   str2 =Me.WebBrowser0.Object.Document.frames.rightFrame.Document.getelementsbytagname("table")(5).Rows(0).Cells(0).innertext
   If str2 <> "" Then
       GetPageStr = str2
   End If
End Function