再請教:
小弟習慣用以下這種語法在抓網頁,似乎前提是能夠找出資料的http,請問上面的綜合損益表能夠找出嗎?
With ActiveSheet.QueryTables.Add(Connection:="URL;http://dj.mybank.com.tw/z/zc/zca/zca_" & mywb1.Sheets("Price").Cells(i, "A") & ".asp.htm", Destination:=Range("$A$1"))
End With
For DQ = 1 To 5
DQQ = 6
Sheets(DQQ).Select
co_id = Range("A" & DQ).Value
Sheets(DQ).Select
'If Not IsNumeric(Val(co_id)) Or Len(co_id) <> 4 Then Exit Sub '不是四位數的數字
isnew = 1
Sub Ex()
Dim i As Integer, s As Integer, k As Integer, A, ii, j
Dim co_id As String, isnew As String, season As String
Dim DQ as Integer, DQQ As Integer
For DQ = 1 To 5
DQQ = 6
Sheets(DQQ).Select
co_id = Range("A" & DQ).Value
Sheets(DQ).Select
isnew = 1
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
With .document
For Each A In .getelementsbytagname("INPUT")
If A.Name = "co_id" Then A.Value = co_id
Next
For Each A In .getelementsbytagname("SELECT")
If A.Name = "isnew" Then
A.Value = True
If isnew = "2" Then
A.Focus
Application.Wait Now + #12:00:02 AM#
Application.SendKeys "{DOWN}"
Application.Wait Now + #12:00:02 AM#
Application.SendKeys "{ENTER}"
End If
End If
If A.Name = "year" And isnew = "2" Then A.Value = Split(season, ",")(0)
If A.Name = "season" And isnew = "2" Then A.Value = Split(season, ",")(1)
Next
For Each A In .getelementsbytagname("INPUT")
If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click '按下[搜索]鍵
Next
End With
Application.Wait Now + #12:00:10 AM# '等待網頁下載資料
Set A = .document.getelementsbytagname("table")
On Error Resume Next '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
With ActiveSheet
.Cells.Clear
'************************
' For ii = 0 To A.Length - 1 '不知道table範圍在何處: 從0開始
'******************************
For ii = 11 To A.Length - 1 ''從11開始 用 Debug.Print ii 找出所要資料的table範圍
For i = 0 To A(ii).Rows.Length - 1 '寫入資料
'Debug.Print ii 可找出所要資料的 table 範圍
k = k + 1
For j = 0 To 5
Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
Next
Next
Next
.Range("C5").Cut Range("D5")
With .Range("B5:C5,D5:E5")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Merge
End With
End With
.Quit '關閉網頁
End With
Next DQ
End Sub作者: cji3cj6xu6 時間: 2013-5-22 23:13
Dear G大，
我找到問題了。
謝謝您送的這個武器，好用。
因為K值會遞增所影響，所以多加一行K=0即可。
For DQ = 1 To 5
DQQ = 6
Sheets(DQQ).Select
co_id = Range("A" & DQ).Value
Sheets(DQ).Select
isnew = 1
k = 0
...........
Next DQ作者: GBKEE 時間: 2013-5-23 07:24
Sub Ex()
Dim i As Integer, s As Integer, k As Integer, A, ii, j
Dim co_id As String, isnew As String, season As String
Dim input_year As String
co_id = InputBox("請輸入 公司代號")
If Not IsNumeric(Val(co_id)) Or Len(co_id) <> 4 Then Exit Sub '不是四位數的數字
isnew = "2"
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://mops.twse.com.tw/mops/web/query6_1"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
With .document
For Each A In .getelementsbytagname("INPUT")
If A.Name = "co_id" Then A.Value = co_id
Next
For Each A In .getelementsbytagname("SELECT")
If A.Name = "isnew" Then
A.Value = True
If isnew = "2" Then
A.Focus
Application.Wait Now + #12:00:02 AM#
Application.SendKeys "{DOWN}"
Application.Wait Now + #12:00:02 AM#
Application.SendKeys "{ENTER}"
End If
End If
If A.Name = "year" And isnew = "2" Then A.Value = "101"
If A.Name = "month" And isnew = "2" Then A.Value = "05"
Next
For Each A In .getelementsbytagname("INPUT")
If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click '按下[搜索]鍵
Next
End With
Application.Wait Now + #12:00:10 AM# '等待網頁下載資料
Set A = .document.getelementsbytagname("table")
On Error Resume Next '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
With ActiveSheet
.Cells.Clear
'************************
' For ii = 0 To A.Length - 1 '不知道table範圍在何處: 從0開始
'******************************
For ii = 11 To A.Length - 1 ''從11開始 用 Debug.Print ii 找出所要資料的table範圍
For i = 0 To A(ii).Rows.Length - 1 '寫入資料
'Debug.Print ii 可找出所要資料的 table 範圍
k = k + 1
For j = 0 To 5
Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
Next
Next
Next
.Range("C5").Cut Range("D5")
With .Range("B5:C5,D5:E5")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Merge
End With
End With
'.Quit '關閉網頁
End With
End Sub
我遇到了IE cookie的問題,"年份" 並不會跟著程式碼中定義的"101" 而變更到101
只有紀錄手動差詢過的年份值而作動,例如
C:\Users\user\AppData\Local\Microsoft\Windows\Temporary Internet Files\Cookie:[email protected]/
內容如下
"D102%"
如果我改成D101% ,在查詢時就可以變成101年,請問VBA有沒有解決方式
我曾經是過用VBA 輸出檔案到這資料夾好像沒有辦法
這個是我測試的程式碼:
Sub XlsToTxT()
Dim MYstr As String, i As Integer '定義屬性
Open "C:\Users\user\AppData\Local\Microsoft\Windows\Temporary Internet Files\63MX5O7N.txt" For Output As #1 '定義Output File位置
Open "C:\63MX5O7N.txt" For Output As #1 '定義Output File位置
For i = 1 To 10 '由 Row 1to10
MYstr = Cells(i, 1) '輸出的內容 (或你要的東西,可在此開始自己定義吧~)
Print #1, MYstr
Next i
Close #1
End Sub
