==========================================
Sub 集保抓取()
Dim A
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
With .document
'-----輸入要查詢的股票代碼
For Each A In .getelementsbytagname("INPUT") '找原始碼有input參數
If A.Name = "StockNo" Then A.Value = Range("B1").Value '找原始碼有input參數
Next
End With
End With
End Sub
==========================================作者: espionage 時間: 2015-9-13 15:29
Hi GBKEE 大大
還是不行耶，底下是VBA碼
1. 跑到 Stop會停下來
2. 如果把Stop拿掉，If element.Length < 7 Then 這一段也先拿掉，程式還是跑到 For i = 0 To element(s).Rows.Length - 1 '資料的列位，這一句報錯，執行階段錯誤 '91': 沒有設定物件變數或 With區塊變數
============================================
Sub 集保抓取()
Dim A, element As Object, i As Integer, k As Integer, J As Integer, jj As Integer, s As Integer
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
With .document
'-----輸入要查詢的股票代碼
For Each A In .getelementsbytagname("INPUT") '找原始碼有input參數
If A.Name = "StockNo" Then A.Value = Range("B1").Value '找原始碼有input參數，後面的name =StockNo
Next
.ALL("SCA_DATE").SELECTEDINDEX = 2
.ALL("sub").Click
End With
Do While .Busy Or .readyState <> 4: DoEvents
Application.SendKeys "~", True '按 ENTER 按鍵 ,預防 "證券代號"有錯誤
Loop
Do
Set element = .document.getelementsbytagname("table")
Loop Until Not element Is Nothing
MsgBox element.Length
'Stop
'If element.Length < 7 Then
'MsgBox "證券代號 ??": Exit Sub
'End If
With Sheets(1)
k = k + 1
For s = 5 To 7 '已找出網頁的table內容在 5-7 中
For i = 0 To element(s).Rows.Length - 1 '資料的列位
For jj = 0 To element(s).Rows(i).Cells.Length - 1 '資料的欄位
.Cells(k, jj + 1) = element(s).Rows(i).Cells(jj).INNERTEXT
Next
k = k + 1
Next
Next
End With
Dim Ar(), a, i As Integer, strDate As String, stkno As String, Qur As String
With CreateObject("InternetExplorer.Application")
.Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set a = .Document.ALL.tags("option") '資料日期的內容
ReDim Ar(a.Length - 1)
For i = 0 To a.Length - 1
Ar(i) = a(i).innerHTML
Next
.Quit
End With
For DateVar = 0 To 28
strDate = Ar(DateVar) '導入當月日期
Do
strDate = InputBox(Join(Ar, vbTab), "集保戶股權分散表查詢 之 有效日期", strDate)
If strDate = "" Then Exit Sub
Loop Until IsNumeric(Application.Match(strDate, Ar, 0))
stkno = InputBox("輸入股票代號", "股票代號", 2313) '
If stkno = "" Then Exit Sub
Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"
With ActiveSheet
For WriteDate = 1 To 1
If .QueryTables.Count = 0 Then
.QueryTables.Add "URL;" & Qur, .[A & WriteDate * 28 * (WriteDate) ]
Else
.QueryTables(1).Connection = "URL;" & Qur
End If
With .QueryTables(1)
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "6,7,8"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next
End With
Next作者: GBKEE 時間: 2015-9-27 06:40
