無法用外部資料匯入的網站能用VBA讀取資料嗎？ - Excel程式區

返回列表下一主題上一主題發帖

[發問] 無法用外部資料匯入的網站能用VBA讀取資料嗎？

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^# 跳轉到 »

發表於 2014-6-7 16:48 | 只看該作者

本帖最後由 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