- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 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程式- Option Explicit
- Sub Ex()
- '請先將專案 [設定引用項目]加入 Microsoft Internet Controls
- Dim shell_windows As New SHDocVw.ShellWindows
- Dim Ie As SHDocVw.InternetExplorer
- For Each Ie In shell_windows
- With Ie
- Do While .Busy Or .ReadyState <> 4: Loop
- If InStr(.Document.Title, "產物保險業務統計查詢結果") Then .Quit
- End With
- Next
- Ex_產物保險業務統計下載
- End Sub
- Sub Ex_產物保險業務統計下載()
- Dim i As Integer, P, xTab As Object, R, C, II
- With CreateObject("InternetExplorer.Application")
- ' .Visible = True
- Do
- .Navigate "http://pivot.tii.org.tw/lifesta/NLifeResult.asp?page=" & i + 1
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- Set xTab = .Document.all.tags("table")
- If i = 0 Then
- P = Split(xTab(2).innertext, ")")(0)
- P = Val(Split(P, "共")(1))
- Cells.Clear
- End If
- Application.StatusBar = "共 " & P & " 頁 / 第 " & i + 1 & " 頁"
- For R = IIf(i = 0, 0, 1) To xTab(1).Rows.Length - 1
- For C = 0 To xTab(1).Rows(R).Cells.Length - 1
- Cells(II + 1, C + 1) = xTab(1).Rows(R).Cells(C).innertext
- Next
- II = II + 1
- Next
- i = i + 1
- Loop Until i = P
- .Quit '關閉網頁
- End With
- End Sub
|
|
發表於 2017-3-27 11:40
| 
