Board logo

標題: [發問] 網頁表單下載 [打印本頁]
作者: lalalada    時間: 2017-3-27 11:40     標題: 網頁表單下載

本帖最後由 lalalada 於 2017-3-27 11:45 編輯

各位前輩好!
我想抓取http://pivot.tii.org.tw/lifesta/DQPFrame1.htm的資料
設定如下圖
[attach]26896[/attach]
然後會跳出新視窗
[attach]26897[/attach]
因為有28頁
想請問是否能一口氣下載成單一excel檔呢?
我知道基本的get/post方法但做不出來....
謝謝!
作者: GBKEE    時間: 2017-3-28 13:19

本帖最後由 GBKEE 於 2017-3-28 13:20 編輯

回復 1# lalalada
1. IE 網址 http://pivot.tii.org.tw/lifesta/DQPFrame1.htm ,(設好要查尋的項目) ,按下[開始查尋]
2.在Excel 上執行,vba程式
  1. Option Explicit
  2. Sub Ex()
  3.     '請先將專案 [設定引用項目]加入  Microsoft Internet Controls
  4.     Dim shell_windows As New SHDocVw.ShellWindows
  5.     Dim Ie As SHDocVw.InternetExplorer
  6.     For Each Ie In shell_windows
  7.         With Ie
  8.             Do While .Busy Or .ReadyState <> 4:         Loop
  9.             If InStr(.Document.Title, "產物保險業務統計查詢結果") Then .Quit
  10.         End With
  11.     Next
  12.     Ex_產物保險業務統計下載
  13. End Sub
  14. Sub Ex_產物保險業務統計下載()
  15.     Dim i As Integer, P, xTab As Object, R, C, II
  16.     With CreateObject("InternetExplorer.Application")
  17.       ' .Visible = True
  18.         Do
  19.             .Navigate "http://pivot.tii.org.tw/lifesta/NLifeResult.asp?page=" & i + 1
  20.             Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  21.             Set xTab = .Document.all.tags("table")
  22.             If i = 0 Then
  23.                 P = Split(xTab(2).innertext, ")")(0)
  24.                 P = Val(Split(P, "共")(1))
  25.                 Cells.Clear
  26.             End If
  27.             Application.StatusBar = "共 " & P & " 頁  /  第 " & i + 1 & " 頁"
  28.             For R = IIf(i = 0, 0, 1) To xTab(1).Rows.Length - 1
  29.                 For C = 0 To xTab(1).Rows(R).Cells.Length - 1
  30.                     Cells(II + 1, C + 1) = xTab(1).Rows(R).Cells(C).innertext
  31.                 Next
  32.                 II = II + 1
  33.             Next
  34.             i = i + 1
  35.         Loop Until i = P
  36.         .Quit        '關閉網頁
  37.     End With
  38. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)