怎麼批次下載js裡的檔案？

torrent

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

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

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

下載 (155.32 KB)

2013-6-7 12:27

GBKEE

回復 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

複製代碼