Board logo

標題: 怎麼批次下載js裡的檔案？ [打印本頁]
作者: torrent    時間: 2013-6-7 12:30     標題: 怎麼批次下載js裡的檔案？

想請教一下，我需要下載環保署污染源資料的excel檔案，大約有3000多筆，但因為連結是javascript，就不知道怎麼寫程式了，不知道各位有沒有辦法。

我需要下載的事業編號都有了，然後網址結構也很簡單，例如這個：http://prtr.epa.gov.tw/resultEMS.aspx?emsno=O1747899&tab=Panel1

我已經用excel做出超連結，如下圖，我是希望能用vba自動下載每一個連結頁面中提供的一個excel檔案。

[attach]15199[/attach]
作者: GBKEE    時間: 2013-6-8 15:21

回復 1# torrent
  1. Option Explicit
  2. Sub Ex()
  3.     Dim I As Integer, Rng As Range
  4.     With ActiveSheet                                        '工作表中 [A欄] 有事業編號
  5.         Set Rng = .[A2]                                     '從A2開始讀取
  6.         Application.DisplayAlerts = False                   '關閉應用程式的詢問
  7.         Do While Rng <> ""                                  '直到A欄沒資料
  8.             With Workbooks.Add(1)                           '新增活頁簿
  9.                 With .Sheets(1).QueryTables.Add(Connection:="URL;http://prtr.epa.gov.tw/resultEMS.aspx?emsno=" & Rng & "&tab=Panel1", _
  10.                     Destination:=[A1])                      '工作表新增,匯入外部查詢.
  11.                     .WebSelectionType = xlSpecifiedTables
  12.                     .WebFormatting = xlWebFormattingNone
  13.                     .WebTables = "6,""GridView3"""
  14.                     .WebPreFormattedTextToColumns = True
  15.                     .WebConsecutiveDelimitersAsOne = True
  16.                     .WebSingleBlockTextImport = False
  17.                     .WebDisableDateRecognition = False
  18.                     .WebDisableRedirections = False
  19.                     .Refresh BackgroundQuery:=False
  20.                     .Parent.Names(.Name).Delete
  21.                     .Delete
  22.                 End With
  23.                 .SaveAs ThisWorkbook.Path & "\" & Rng   '存檔資料夾名稱
  24.                 ' .Close                                '關閉檔案
  25.             End With
  26.             Set Rng = Rng.Offset(1)                     '下移一列
  27.         Loop
  28.         Application.DisplayAlerts = True                '恢復應用程式的詢問
  29.     End With
  30. End Sub
複製代碼




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