- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2014-6-7 18:23 編輯
回復 2# 小俠客
試試看- Option Explicit
- Const FormDLL = "FM20.DLL"
- Sub IE下一頁()
- Dim URL As String, A As Object, Table As Object, i As Integer, pubSrch As Object, Pages As Integer
- Dim Sh As Worksheet, B As String
- Set_FormDLL
- Set Sh = ActiveSheet
- Sh.Cells.Clear
- URL = "https://eservices.customs.gov.hk/MSOS/wsrh/001s1?searchBy=A"
- With CreateObject("InternetExplorer.Application")
- .Visible = True ' 是否顯示 IE
- .Navigate URL
- Do While .ReadyState <> 4 Or .Busy
- DoEvents
- Loop
- Set A = .Document.getElementsByTAGName("A")
- For i = 0 To A.Length - 1
- If A(i).innertext = "ALL" Then
- A(i).Click
- Exit For
- End If
- Next
- Do While .ReadyState <> 4 Or .Busy
- DoEvents
- Loop
- Do
- Set A = .Document.getElementsByTAGName("TD")
- Loop Until Not A Is Nothing And A.Length = 84
- For i = 0 To A.Length - 1
- If A(i).ID = "grid-table-pubSrch_center" Then
- Pages = Val(Replace(A(i).innertext, "Page of ", "")) '總頁數
- End If
- If A(i).ID = "next_grid-table-pubSrch" Then Set pubSrch = A(i) '下一頁按鍵
- Next
- Set Table = .Document.getElementsByTAGName("table")
- For i = 1 To Pages
- If i >= 2 Then
- pubSrch.Click
- Do While .ReadyState <> 4 Or .Busy: Loop
- Set Table = .Document.getElementsByTAGName("table")
- Do: Loop Until B <> Table(6).outerHTML
- End If
- Ep Sh, Table(6).outerHTML
- B = Table(6).outerHTML
- Next
- .Quit
- End With
- With Sh
- .Cells.WrapText = False
- Intersect(Range("b:b").SpecialCells(xlCellTypeBlanks).EntireRow, .Range("c:c").SpecialCells(xlCellTypeBlanks).EntireRow).Delete
- .Cells.EntireRow.AutoFit
- .Range("a1").Activate
- End With
- Remove_FormDLL
- End Sub
- Private Sub Set_FormDLL() '新增引用 Microsoft Forms 2.0 Object Library
- On Error Resume Next
- ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
- ' On Error GoTo 0
- End Sub
- Private Sub Remove_FormDLL() '刪除引用 Microsoft Forms 2.0 Object Library
- Dim D As Object
- For Each D In ThisWorkbook.VBProject.References
- If UCase(D.fullpath) Like "*" & FormDLL Then
- ThisWorkbook.VBProject.References.Remove D
- End If
- Next
- End Sub
- Private Sub Ep(Sh As Worksheet, S As String)
- Dim D As New DataObject, E As Shape, FormDLL As String ', Rng As Range
- 'DataObject 物件 在進行轉換動作時，做為格式化文字資料的暫存區域。其也可以暫存和儲存在 DataObject 的文字片段相關的格式。
- '宣告 Dim D As New DataObject '須在工具-> 設定引用項目加入 新增引用 Microsoft Forms 2.0 Object Library ,專案 加入一表單即可
- With D
- .SetText S
- .PutInClipboard
- With Sh
- .Cells(.Rows.Count, "b").End(xlUp).Offset(1, -1).Select
- .PasteSpecial Format:="Unicode 文字"
- End With
- End With
- End Sub
|
|
發表於 2014-6-7 16:48
| 
