Board logo

標題: 使用VBA抓取網頁資料，大約不到200頁就會當掉，求解 [打印本頁]
作者: clio    時間: 2018-10-8 15:01     標題: 使用VBA抓取網頁資料，大約不到200頁就會當掉，求解

各位大大，小弟我目前遇到一個自己能力無法解出的問題，還望各位大大知道怎麼解決的告知小弟，感謝您。
目前要抓取某家公司放在網路上的零件資料，大約4萬多頁，只要跑大約200左右就會當機，不知道是什麼問題，小弟有放上程式，還請各位大大協助，感謝您。
作者: joey0415    時間: 2018-10-8 16:26

回復 1# clio

Sub 巨集1()
    Cells.Clear
SURL = "URL;http://www.passivecomponent.com/asp/search_chip.aspx?page2"
Set myQT = ActiveSheet.QueryTables.Add(Connection:=SURL, Destination:=Range("$A$1"))
    With myQT
        .WebFormatting = xlWebFormattingNone
        .Refresh BackgroundQuery:=False
        .Delete
    End With

SET MYQT=NOTHING
End Sub

頁數自己換
作者: clio    時間: 2018-10-8 18:24

回復 2# joey0415
HI Joey0415,
測試過，這樣更早就當掉了說…
作者: GBKEE    時間: 2018-10-8 19:10

回復 3# clio
沒有別的網址可下載嗎?
測到1500頁跑近10分鐘, 40377 頁要跑很久請自己測試
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh(1 To 2) As Worksheet, q As QueryTable, i  As Long, Rng As Range
  4.     Dim xTime As Date
  5.     With ThisWorkbook
  6.         Set Sh(1) = .Sheets(1)
  7.         Set Sh(2) = .Sheets(2)  '**.Sheets("工作表3")
  8.     End With
  9.     With Sh(1)
  10.        '****這段是要刪除工作表1上有太多的 QueryTable  (會當可能是在這)****   
  11.         For Each q In .QueryTables
  12.             q.Delete
  13.         Next
  14.         '****這段是要刪除工作表1上QueryTable的名稱
  15.         For i = .Names.Count To 1 Step -1
  16.             .Names.Item(i).Delete
  17.         Next
  18.         '**設定你的外部查詢在固定的QueryTable上
  19.         If .QueryTables.Count > 0 Then
  20.             Set q = .QueryTables(1)
  21.         Else
  22.             Set q = .QueryTables.Add(Connection:="URL;http://www.passivecomponent.com/asp/search_chip.aspx?page=1" _
  23.                         , Destination:=.[A1])
  24.         End If
  25.     End With
  26.     xTime = Time
  27.     Application.ScreenUpdating = False
  28.     For i = 1 To 40377
  29.         With q
  30.             .Connection = "URL;http://www.passivecomponent.com/asp/search_chip.aspx?page=" & i
  31.             .WebFormatting = xlNone
  32.             .RefreshStyle = xlInsertDeleteCells
  33.             .AdjustColumnWidth = True
  34.             .Refresh BackgroundQuery:=False
  35.             DoEvents
  36.             Set Rng = .ResultRange '**外部查詢的資料區
  37.             If i = 1 Then
  38.                 Sh(2).UsedRange.Clear
  39.                 Sh(2).Range("A1").Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Value
  40.             Else
  41.                 Sh(2).Range("A" & Sh(2).Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(Rng.Rows.Count, Rng.Columns.Count) = Rng.Offset(1).Value
  42.             End If
  43.         End With
  44.         Application.StatusBar = "下載開始: " & xTime & " 共 " & i & " 頁 ok " & Application.Text(Time - xTime, ["m分s秒"])
  45.     Next
  46.     Application.ScreenUpdating = True
  47.     MsgBox Application.Text(Time - xTime, ["m分s秒"]) & "   Finish"
  48. End Sub
複製代碼
作者: joey0415    時間: 2018-10-8 20:59

回復 3# clio

我也測試過哦！三分鐘下載300頁沒有問題
很順
作者: clio    時間: 2018-10-9 09:14

回復 5# joey0415
Hi Joey0415,
能否也把您的完整程式，讓我來研究一下，看是差別在那邊，為什麼我的會當掉，若是方便的話，感謝您。
作者: clio    時間: 2018-10-9 10:54

回復 4# GBKEE
感謝GBKEE,
拜讀了您的程式，我大約知道我卡在那個地方了，而且妳的撰寫方式，讓我受用很多，太感謝您了
我大約知道該該表單的QueryTables太多了，有五百多個，難怪會卡住，所以我了解要把QueryTales砍掉的原因了
但是為什麼會有這樣多的Names，而且把這些Names砍掉的好處是，什麼，這點我不太清楚，能否請GBKEE幫我解說一下呢？
感謝您
作者: GBKEE    時間: 2018-10-9 12:55

本帖最後由 GBKEE 於 2018-10-9 12:56 編輯

回復 7# clio
檔案瘦身
QueryTable ,Name太多檔案會虛胖,你一直的存檔動作,會喘死.
作者: clio    時間: 2018-10-9 13:12

回復 8# GBKEE
了解了，感謝GBKEE，所以把所有的QueryTable刪掉，只留下一個，並利用迴圈改變q的connection值，就不會讓QueryTable的數量一直增加，這樣也不會像我原來的程式一樣，因為QueryTable超過一定的數量，造成當掉，這樣我就全理解了，感謝您的耐心解說
作者: mark15jill    時間: 2018-12-30 10:35

回復  clio
檔案瘦身
QueryTable ,Name太多檔案會虛胖,你一直的存檔動作,會喘死.
GBKEE 發表於 2018-10-9 12:55



    這個比喻真好... 編寫程式時 很多都只在意速度 確連不用丟進迴圈的也丟進去 導致一個固定值 被執行N次 ....



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