請問如何抓取javascript的*.csv檔案？

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兔年全勤獎章

11^# 跳轉到 »

發表於 2014-1-5 17:02 | 只看該作者

回復 10# torrent
試試看

Option Explicit
Sub Ex() '全部資料超過 65536筆 2003版不適用
Dim Sh As Worksheet, wb As Workbook, i As Long
Set Sh = ActiveWorkbook.Sheets(1)
Sh.UsedRange = ""
i = 0
Do
Workbooks.OpenText Filename:="http://opendata.epa.gov.tw/ws/Data/EMS/?$orderby=RegistrationNo&$skip=" & i & "&$top=1000&format=csv" _
, Origin:=-535, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1)), TrailingMinusNumbers:=True
With ActiveWorkbook.Sheets(1).UsedRange
If .Cells(1) = "" Then Exit Do
If i = 0 Then
.Copy Sh.[a1]
Else
.Offset(1).Copy Sh.[a1].End(xlDown).Offset(1)
End If
ActiveWorkbook.Close False
End With
i = i + 1000
Loop
ActiveWorkbook.Close False
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

torrent

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: Windows 7
軟體版本: 2010
閱讀權限: 10
註冊時間: 2013-6-7
最後登錄: 2014-1-25

12^#

發表於 2014-1-6 05:18 | 只看該作者

回復 11# GBKEE

受教了，原來要用Workbooks。

另外，我在GBKEE大大幫我修正的第二個code中做了一些修正，目的是把A欄的管制編號填滿，我在第31列加了這一行：

.Resize(Q.ResultRange.Rows.Count, 1).Offset(2, -1).Value = Rng

看起來除了最後一個管制編號會多兩行尾巴之外，好像沒有其它的問題，不知道各位有沒有更好的意見或看出這樣搞會有bug？

謝謝

Sub punish()
Dim Sh As Worksheet, Rng As Range, Q As Variant
Application.ScreenUpdating = False
Set Rng = Sheets("Sheet1").Range("A2") '管制編號
On Error GoTo ER
With Sheets("管制內容")
Set Sh = Sheets(.Name)
.UsedRange = ""
End With
On Error Resume Next
With Sh.QueryTables.Add("URL;http://prtr.epa.gov.tw/resultEMS.aspx?emsno=" & Rng & "&tab=Panel5", Sh.[AA1])
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """GridView5"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Set Q = Sh.QueryTables(1)
Do While Rng <> ""
If Err = 0 And Application.Count(Q.ResultRange) > 0 Then
With Sh.Cells(Sh.Rows.Count, 2).End(xlUp)
.Offset(1, -1) = Rng
If .Row = 1 Then
.Offset(, -1) = "管制編號"
Q.ResultRange.Copy .Cells
Else
.Resize(Q.ResultRange.Rows.Count, 1).Offset(2, -1).Value = Rng
Q.ResultRange.Rows("2:" & Q.ResultRange.Rows.Count).Copy .Offset(1)
End If
End With
End If
Err.Clear
Set Rng = Rng.Offset(1)
Q.Connection = "URL;http://prtr.epa.gov.tw/resultEMS.aspx?emsno=" & Rng & "&tab=Panel5"
Q.Refresh BackgroundQuery:=False
Loop
Q.ResultRange = ""
With Sh
.Columns.AutoFit
For Each Q In .Names
Q.Delete
Next
For Each Q In .QueryTables
Q.Delete
Next
End With
Application.ScreenUpdating = True
Exit Sub
ER:
If Err.Number = 9 Then
Sheets.Add.Name = "管制內容"
Resume
End If
End Sub