- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
3#
發表於 2016-8-18 14:38
| 只看該作者
本帖最後由 GBKEE 於 2016-8-20 09:46 編輯
回復 2# Michelle-W
google 會有流量管制限制資料的下載
試試看- Option Explicit
- Sub 資料搜尋()
- Dim IE As Object, MyState As String, E As Object
- Dim Sh As Worksheet, Msg As Boolean, i As Integer
- With Workbooks.Open(ThisWorkbook.Path & "\資料處理.xlsm") '打開另一個excel做為資料儲存
- Set Sh = .Sheets("SHEET2")
- Sh.Cells.Clear
- End With
- Set IE = CreateObject("InternetExplorer.Application")
- With IE
- .Visible = True 'False
- .Navigate ("https://www.google.com")
- End With
- MyState = ThisWorkbook.Sheets("sheet1").Range("A2") 'B2為關鍵字,打開IE
- While IE.Busy Or IE.readyState <> 4: DoEvents: Wend '確保網頁完整打開
- For Each E In IE.Document.getelementsbytagname("input")
- If E.Name = "q" Then: E.Value = MyState: Exit For '找到input,填入輸入值
- Next
- While IE.Busy Or IE.readyState <> 4: DoEvents: Wend '確保網頁完整打開
- IE.Document.getElementsByName("btnG").Item.Click '按下搜尋紐
- ag: '下載搜尋結果
- Msg = False
- While IE.Busy Or IE.readyState <> 4: DoEvents: Wend '確保網頁完整打開
- 'FnWait (0.7) '等待時間 :等候網頁整理完畢
- Do While IE.Busy: DoEvents: Loop
- For Each E In IE.Document.ALL.TAGS("H3")
- i = i + 1
- Sh.Cells(Sh.Range("A" & Sh.Rows.Count).End(xlUp).Row + 1, 1) = E.ALL(0).innertext
- Sh.Cells(Sh.Range("B" & Sh.Rows.Count).End(xlUp).Row + 1, 2) = E.ALL(0).HREF
- Application.StatusBar = E.ALL(0).innertext
- Next
- For Each E In IE.Document.ALL.TAGS("span")
- If E.innertext = "下一頁" Then
- Msg = True
- E.Click
- Exit For
- End If
- Next
- If Msg Then GoTo ag
- If IE.LocationURL Like "https://ipv4.google.com/sorry/IndexRedirect?*" Then '** 被 google 流量管制
- MsgBox "請先到 IE 輸入:驗證數字,再回到Excel 按下確定鍵 ", , "google 流量管制"
- GoTo ag
- End If
- Application.StatusBar = MyState & " 共 google " & i
- IE.Quit
- End Sub
-
|
|
發表於 2016-7-25 17:44
| 
