12345678910
返回列表 上一主題 發帖

[發問] 可否用迴圈或變數匯入大量資料？

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
71# 跳轉到 »
發表於 2014-5-23 19:14 | 只看該作者
回復 70# GBKEE
哈囉！版主您好，再度將您修正過後都程式碼代入之後仍是在相同位置出現"424"的錯誤，由於您的EXCEL版本並非2007，所以也沒辦法一一測試我的錯誤
看來這個問題似乎需要再慢慢研究
我用2003執行是正常的，不過在執行的過程中，我發現抓下來的資料會有一些問題

如圖，有些日期的資料是重覆的，有些日期的資料卻漏抓，103年3月份抓了2次，103年2月卻漏抓，但這個情況只有在按下F5連續執行時才會發生
按F8逐行執行則不會，不知道為什麼會這樣？想請問兩個問題
1.這種狀況有辦法加入其他程式碼來避免嗎？
2.就我的感覺應該是F5連續執行的速度太快，以致於網頁反應不及，還來不及跳到下一筆日期就抓資料了才會出錯，不知道這樣推斷正不正確？

附上完整的文字檔，再麻煩您幫忙看看囉！感謝！
1103嘉泥集保戶.zip (1.99 KB)

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
72#
發表於 2014-5-24 12:50 | 只看該作者
回復 70# GBKEE
版主您好，我在無意中發現了可以解決錯誤的方法，也不需要再另外設物件，只要將.document.getElementById("StockNo").Value=E
改成.document.All("StockNo").Value=E就可以了，也就是getElementById改成All就可以正常執行了
只是不清楚為什麼這樣改就可以了
  1.     For Each E In Rng
  2.         With Sheets(1)
  3.             .Activate
  4.             .Cells.Clear  '下載資料置於此工作表,變換股票時:清空
  5.         End With
  6.         For x = 0 To A
  7.             With IE
  8.                 .document.getelementsByTagName("select")("SCA_DATE")(x).Selected = True
  9.                                             '這裡的資料日期 需用 Select 它是有[年度月份日期]的
  10.                 .document.All("StockNo").Value = E
  11.                 .document.getelementsByTagName("INPUT")("sub").Click  '按下查詢
  12.                 Do While .Busy Or .readyState <> 4:    Loop
  13.                 If x = 0 Then Sheets(1).Cells(1) = .document.getelementsByTagName("TABLE")(5).INNERTEXT
  14.                 Ep .document.getelementsByTagName("TABLE")(6).INNERTEXT
  15.                 Ep .document.getelementsByTagName("TABLE")(7).outerHTML
  16.             End With
  17.         Next x
  18.         xFile = xPath & "\" & E & "\SHD.txt"
  19.         MkDir_Sub xFile
  20.         Maketxt xFile, Sheets(1).UsedRange, E.Value
  21.         ii = ii + 1
  22.         Application.StatusBar = Application.Text(Time - T, ["MM分SS秒"]) & " 共匯入上市月成交 " & ii & " 文字檔"
  23.     Next E
複製代碼
不過又遇到了另一個問題，就是當個股遇到沒當年度月份的資料時，就會出現查無資料的視窗，這是連續執行的結果


而當我用F8逐行執行的結果，當遇到查無年度月份資料時，就會一直在Do While .Busy Or .readyState <> 4:    Loop執行無窮迴圈
請問這部分是否有辦法解決？我個人猜想應該是要修正變數A或x的程式碼，但卻不清楚該怎麼修改，只好再麻煩您幫忙看看了，謝謝！

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
73#
發表於 2014-5-25 16:16 | 只看該作者
回復 72# smart3135
  1. Sub 集保()
  2.     Dim Rng As Range, E As Range, x As Variant, T As Date, xPath As String, xFile As String
  3.     Dim Ea As Variant, ii As Integer, F As String, H As String, j As Integer
  4.     T = Time
  5.     Application.DisplayStatusBar = True
  6.     '請將上櫃的股票代號,在 Sheets(3).Range("A1")往下Key上,迴圈依這裡的股票代號匯入
  7.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  8.     If Application.Count(Rng) = 0 Then MsgBox "沒有股票代號": Exit Sub
  9.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  10.     xPath = "D:\財報資料"
  11.     IE_Application    '
  12.     IE.Visible = True   '必須顯示IE ,查無資料,按下確定鍵
  13.     Application.StatusBar = " "
  14.     For Each E In Rng
  15.         With Sheets(1)
  16.             .Activate
  17.             .Cells.Clear  '下載資料置於此工作表,變換股票時:清空
  18.         End With
  19.         For x = 0 To A
  20.             With IE
  21.                 .document.getelementsbytagname("select")("SCA_DATE")(x).Selected = True
  22.                '.document.getElementById("StockNo").Value = E  'getElementById於 2007有錯誤
  23.                 .document.ALL("StockNo").Value = E             'ALL 於2007可行
  24.                 .document.getelementsbytagname("INPUT")("sub").Click  '按下查詢
  25.                 On Error Resume Next   '程式有錯誤時:繼續執行下去
  26.                 Do While .Busy Or .readyState <> 4
  27.                     Do
  28.                         Err.Clear
  29.                         'IE接收資料尚未完成 .document.getelementsbytagname("TABLE").Length 會有錯誤
  30.                         If .document.getelementsbytagname("TABLE").Length <= 5 Then '查無資料
  31.                             Application.SendKeys "~", True ' 按下確定鍵
  32.                             GoTo Nextx
  33.                         End If
  34.                     Loop Until Err = 0
  35.                  Loop
  36.                  On Error GoTo 0   '程式有錯誤時:不處裡
  37.                 If x = 0 Then Sheets(1).Cells(1) = .document.getelementsbytagname("TABLE")(5).INNERTEXT
  38.                 Ep .document.getelementsbytagname("TABLE")(6).INNERTEXT
  39.                 Ep .document.getelementsbytagname("TABLE")(7).outerHTML
  40.             End With
  41.         Next x
  42. Nextx:
  43.         If Sheets(1).UsedRange.Rows.Count > 1 Then
  44.             xFile = xPath & "\" & E & "\SHD.txt"
  45.             MkDir_Sub xFile
  46.             Maketxt xFile, Sheets(1).UsedRange, E.Value
  47.             ii = ii + 1
  48.             Application.StatusBar = Application.Text(Time - T, ["MM分SS秒"]) & " 共匯入上市月成交 " & ii & " 文字檔"
  49.         End If
  50.     Next E
  51.     IE.Quit
  52.     Application.StatusBar = Application.Text(Time - T, ["MM分SS秒"]) & " 共匯入上市月成交 " & ii & " 文字檔,  讀取完畢 !! "
  53.     MsgBox "匯入 文字檔" & ii & " 費時 " & Application.Text(Time - T, ["MM分SS秒"])
  54. '    ThisWorkbook.Save
  55. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
74#
發表於 2014-5-25 23:53 | 只看該作者
回復 73# GBKEE
版主您好，試著將您新增的程式碼代入，的確是可以避免錯誤的發生，但在執行程式後會變成擷取的資料不完整
例如1301的資料是從2014年5月到2013年5月，可是在擷取資料時卻沒辦法抓下完整資料，有時只抓到一個月，有時只抓到三個月
不知您是否能幫忙執行看看是否和我說的結果相同
相較於之前還未加入您在73#的程式碼，雖然當遇到查無日期會出錯，不過當有完整一年份資料日期時
抓到的資料都是完整的
我自己也有適著寫入一些程式碼，或著變換程式碼的一些先後位置，但執行結果都不理想
不知道有沒有更適合的程式碼，能避免出錯，也能讓抓到的資料是完整的，再麻煩您幫忙看看了，謝謝！
附帶一提，不會出錯的那個程式用F8逐行執行似乎可以抓到完整資料，但用F5連續執行，抓到的資料就會不完整
不知道是不是因為用連續執行的速度太快，網頁來不及反應，所以抓到的資料才不完整
集保兩個程式+兩個資料不完整文字檔.zip (47.24 KB)

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
75#
發表於 2014-5-26 09:50 | 只看該作者
回復 73# GBKEE
版主，不好意思，上一篇回覆其中一個檔案有錯誤，我再重新附上
另外我花了一些時間做出了另一個版本的程式，是利用儲存格輸入日期當作迴圈，已測試可以抓資料，但有些小問題：
1.有些語法我不太懂怎麼簡化，所以可能寫的比較複雜一點
2.利用儲存格當日期迴圈的缺點，就是每個月都要更新儲存格中的日期
3.我自己寫的程式碼執行到代碼1340時還是會出錯，不過如果把第一個代碼重新設成1340開始抓資料又正常
4.因為表頭的文字會重覆抓取，但我只需要一次，所以用一列一列刪除的笨方法

這個程式寫的比較粗糙，抓資料的速度似乎也比較慢，不過確實可以達到我需要的結果，除了遇到某些代碼會卡住需要重新設定外
其他都還OK，再請您幫忙看一下是否有錯誤的地方需要修正，謝謝！
集保新的.zip (42.48 KB)
  1. Option Explicit
  2. Sub 集保完成()
  3.     Dim E As Range, X As Range, URL As String, xPath As String, xFile As String, rng As Range, rng1 As Range
  4.     Dim Msg As Boolean, I As Integer, t As Date, S As String, BB As String, CC As String, rng2 As Range
  5.     t = Time
  6.     URL = "URL;http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE="
  7.     BB = "&SqlMethod=StockNo&StockNo="
  8.     CC = "&sub=%ACd%B8%DF"
  9.     xPath = "D:\財報資料"
  10.     With ThisWorkbook
  11.         With .Sheets(3)
  12.             Set rng = .Range("A1", .Range("A1").End(xlDown))
  13.             Set rng1 = .Range("B1", .Range("B1").End(xlDown))
  14.         End With
  15. '        .Sheets(3).Activate    '兩種寫法都可以 不過第一種比較簡化 所以第二種跳過
  16. '        .Sheets(3).Range("a1").Select
  17. '        Range(Selection, Selection.End(xlDown)).Select
  18. '        Set rng = Selection
  19. ''        Set rng = .Sheets(3).Range("A:A")  '這裡這樣設定會變成無窮迴圈
  20. '        .Sheets(1).Activate
  21.         With .Sheets(1)      '活頁簿的第 1 張工作表
  22.             If .QueryTables.Count = 0 Then
  23.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  24.                     .Refresh BackgroundQuery:=False
  25.                 End With
  26.             End If
  27.             
  28.             For Each E In rng
  29.                 With ThisWorkbook
  30.                 .Sheets(2).Cells.Clear
  31. '                .Activate
  32.                 .Sheets(1).Cells.Clear  '下載資料置於此工作表,變換股票時:清空
  33.             End With

  35.                 For Each X In rng1
  36.                     With .QueryTables(1)
  37.                         .Connection = URL & X & BB & E & CC
  38.                         .PreserveFormatting = True
  39.                         .BackgroundQuery = True
  40.                         .RefreshStyle = xlInsertDeleteCells
  41.                         .SaveData = True
  42.                         .AdjustColumnWidth = True
  43.                         .RefreshPeriod = 0
  44.                         .WebSelectionType = xlSpecifiedTables
  45.                         .WebFormatting = xlWebFormattingNone
  46.                         .WebTables = "6,7,8"
  47.                         On Error GoTo xlnext
  48.                         .WebPreFormattedTextToColumns = True
  49.                         .WebConsecutiveDelimitersAsOne = True
  50.                         .Refresh BackgroundQuery:=False
  51.                     End With
  52.                     Set rng2 = Sheets(1).UsedRange
  53.                     If Sheets(2).Range("a1") = "" Then
  54.                         rng2.Copy Sheets(2).Range("a" & .Rows.Count).End(xlUp)
  55.                     Else
  56.                         rng2.Copy Sheets(2).Range("a" & .Rows.Count).End(xlUp).Offset(2, 0)
  57.                     End If
  58.                 Next X
  59. xlnext:
  60.                     Sheets(2).Range("2:2,22:22,43:43,64:64,85:85,106:106,127:127,148:148,169:169,190:190,211:211,232:232,253:253").Delete
  61.                     xFile = xPath & "\" & E & "\SHD.txt"
  62.                     MkDir_Sub xFile       '10#的程式 'C槽下的季損益表資料夾不需先建立
  63.                     Maketxt xFile, Sheets(2).UsedRange

  65. '                S = " " & Sheets(1).QueryTables(1).ResultRange(1)
  66. '                If Val(S) < 0 Then S = " 查無"
  67.                 I = I + 1
  68.                 Application.StatusBar = Application.Text(Time - t, ["MM分SS秒"]) & "  " & E & "匯入" & I & "個文字檔"
  69.                 Msg = False
  70.             Next E
  71.         End With
  72.     End With
  73.     MsgBox "共匯入 文字檔" & I & " 費時 " & Application.Text(Time - t, ["MM分SS秒"])
  74. End Sub
  75. Sub MkDir_Sub(S As String)
  76.     Dim AR, I As Integer, xPath As String
  77.     If Dir(S) = "" Then
  78.         AR = Split(S, "\")
  79.         xPath = AR(0)
  80.         For I = 1 To UBound(AR) - 1
  81.             xPath = xPath & "\" & AR(I)
  82.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  83.         Next
  84.     End If
  85. End Sub
  86. Sub Maketxt(xF As String, Q As Range)   '將匯入資料存入指定的txt
  87.     Dim fs As Object, E As Range, C As Variant
  88.     Set fs = CreateObject("Scripting.FileSystemObject")
  89.     Set fs = fs.CreateTextFile(xF, True)  '創見一個檔案,如檔案存在可覆蓋掉
  90.     For Each E In Q.Rows
  91.         C = Application.Transpose(Application.Transpose(E.Value))
  92.         C = Join(C, vbTab)
  93.         fs.WriteLine C
  94.     Next
  95.     fs.Close
  96. End Sub
複製代碼

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
76#
發表於 2014-5-26 11:45 | 只看該作者
回復 73# GBKEE
Sorry，儲存格又忘了填上資料，再附上正確檔案
集保-設定日期為儲存格迴圈.zip (26.86 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
77#
發表於 2014-5-26 17:12 | 只看該作者
本帖最後由 GBKEE 於 2014-5-26 17:15 編輯

回復 75# smart3135
  1. Option Explicit
  2. Sub 集保完成()
  3.     Dim E As Range, X As Range, URL As String, xPath As String, xFile As String, rng As Range, rng1 As Range
  4.     Dim Msg As Boolean, I As Integer, t As Date, S As String, BB As String, CC As String, rng2 As Range
  5.     IE_Application  '更新集保戶股權分散表查詢的資料日期
  6.     t = Time
  7.     URL = "URL;http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE="
  8.     BB = "&SqlMethod=StockNo&StockNo="
  9.     CC = "&sub=%ACd%B8%DF"
  10.     xPath = "D:\財報資料"
  11.     With ThisWorkbook
  12.         With .Sheets(3)
  13.             Set rng = .Range("A1", .Range("A1").End(xlDown))
  14.             Set rng1 = .Range("B1", .Range("B1").End(xlDown))
  15.         End With
  16.         With .Sheets(1)      '活頁簿的第 1 張工作表
  17.             If .QueryTables.Count = 0 Then
  18.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  19.                     .Refresh BackgroundQuery:=False
  20.                 End With
  21.             End If
  22.             
  23.             For Each E In rng
  24.                 With ThisWorkbook
  25.                 .Sheets(2).Cells.Clear
  26.                 .Sheets(1).Cells.Clear  '下載資料置於此工作表,變換股票時:清空
  27.             End With
  28.                 For Each X In rng1
  29.                     With .QueryTables(1)
  30.                         .Connection = URL & X & BB & E & CC
  31.                         .PreserveFormatting = True
  32.                         .BackgroundQuery = True
  33.                         .RefreshStyle = xlInsertDeleteCells
  34.                         .SaveData = True
  35.                         .AdjustColumnWidth = True
  36.                         .RefreshPeriod = 0
  37.                         .WebSelectionType = xlSpecifiedTables
  38.                         .WebFormatting = xlWebFormattingNone
  39.                         If X.Row = 1 Then
  40.                         .WebTables = "6,7,8"
  41.                         Else
  42.                             .WebTables = "7,8"
  43.                         End If
  44.                         On Error GoTo xlnext
  45.                         .WebPreFormattedTextToColumns = True
  46.                         .WebConsecutiveDelimitersAsOne = True
  47.                         .Refresh BackgroundQuery:=False
  48.                         If Sheets(2).Range("a1") = "" Then
  49.                             .ResultRange.Copy Sheets(2).Range("a" & Sheets(2).Rows.Count).End(xlUp)
  50.                         Else
  51.                             .ResultRange.Copy Sheets(2).Range("a" & Sheets(2).Rows.Count).End(xlUp).Offset(2, 0)
  52.                         End If
  53.                     End With
  54.                 Next
  55. xlnext:
  56.       
  57.                     xFile = xPath & "\" & E & "\SHD.txt"
  58.                     MkDir_Sub xFile       '10#的程式 'C槽下的季損益表資料夾不需先建立
  59.                     Maketxt xFile, Sheets(2).UsedRange
  60.                 I = I + 1
  61.                 Application.StatusBar = Application.Text(Time - t, ["MM分SS秒"]) & "  " & E & "匯入" & I & "個文字檔"
  62.                 Msg = False
  63.             Next E
  64.         End With
  65.     End With
  66.     MsgBox "共匯入 文字檔" & I & " 費時 " & Application.Text(Time - t, ["MM分SS秒"])
  67. End Sub
  68. Sub Maketxt(xF As String, Q As Range)   '將匯入資料存入指定的txt
  69.     Dim fs As Object, E As Range, C As Variant
  70.     '*************************
  71.     Q.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete  '刪除空白列
  72.     '*************************
  73.     Set fs = CreateObject("Scripting.FileSystemObject")
  74.     Set fs = fs.CreateTextFile(xF, True)  '創見一個檔案,如檔案存在可覆蓋掉
  75.     For Each E In Q.Rows
  76.         C = Application.Transpose(Application.Transpose(E.Value))
  77.         C = Join(C, vbTab)
  78.         fs.WriteLine C
  79.     Next
  80.     fs.Close
  81. End Sub
  82. Private Sub IE_Application() '更新集保戶股權分散表查詢的資料日期
  83.     Dim IE As Object, A As Object, I As Integer
  84.     Set IE = CreateObject("InternetExplorer.Application")
  85.     With IE
  86.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  87.         .Visible = True
  88.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  89.         '讀取集保戶股權分散表查詢的資料日期
  90.         Set A = .document.getelementsbytagname("option")
  91.        For I = 0 To A.Length - 1
  92.         ThisWorkbook.Sheets(3).Cells(I + 1, "B") = A(I).INNERTEXT
  93.        Next
  94.        .Quit
  95.   End With
  96. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
78#
發表於 2014-5-26 17:13 | 只看該作者
回復 74# smart3135
  1. Option Explicit
  2. Dim IE As Object, A As Integer
  3. Sub IE_Application()
  4.     Dim I As Integer
  5.     Set IE = CreateObject("InternetExplorer.Application")
  6.     With IE
  7.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  8.         .Visible = True   '不顯示ie
  9.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  10.         '讀取集保戶股權分散表查詢的資料日期總個數
  11.         A = .document.getelementsbytagname("select")("SCA_DATE").Length - 1
  12.   End With
  13. End Sub
  14. Sub 集保()
  15.     Dim Rng As Range, E As Range, x As Variant, T As Date, xPath As String, xFile As String
  16.     Dim Ea As Variant, ii As Integer, F As String, H As String, J As Integer
  17.     Dim StockNo  As Object
  18.     T = Time
  19.     Application.DisplayStatusBar = True
  20.     '請將上櫃的股票代號,在 Sheets(3).Range("A1")往下Key上,迴圈依這裡的股票代號匯入
  21.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  22.     If Application.Count(Rng) = 0 Then MsgBox "沒有股票代號": Exit Sub
  23.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  24.     xPath = "D:\財報資料"
  25.     IE_Application    '
  26.     Application.StatusBar = " "
  27.     For Each E In Rng
  28.             With Sheets(1)
  29.                 .Activate
  30.                 .Cells.Clear  '下載資料置於此工作表,變換股票時:清空
  31.             End With
  32.             For x = 0 To A
  33.                 With IE
  34.                     .document.getelementsbytagname("select")("SCA_DATE")(x).Selected = True
  35.                    '.document.getElementById("StockNo").Value = E  'getElementById於 2007有錯誤
  36.                     .document.ALL("StockNo").Value = E             'ALL 於2007可行
  37.                     .document.getelementsbytagname("INPUT")("sub").Click  '按下查詢
  38.                     Do While .Busy Or .readyState <> 4
  39.                         .document.Focus
  40.                         Application.SendKeys "~", True ' 按下確定鍵
  41.                     Loop
  42.                     Set StockNo = Nothing
  43.                     Do While StockNo Is Nothing
  44.                         Set StockNo = .document.getelementsbytagname("TABLE")
  45.                     Loop
  46.                     With StockNo
  47.                        If .Length <= 5 Then GoTo Nextx  '查無資料
  48.                         If x = 0 Then Sheets(1).Cells(1) = .Item(5).INNERTEXT
  49.                         Ep .Item(6).INNERTEXT
  50.                         Ep .Item(7).outerHTML
  51.                     End With
  52.                 End With
  53.             Next x
  54. Nextx:
  55.             If Sheets(1).UsedRange.Rows.Count > 1 Then
  56.                 xFile = xPath & "\" & E & "\SHD.txt"
  57.                 MkDir_Sub xFile
  58.                 Maketxt xFile, Sheets(1).UsedRange, E.Value
  59.                 ii = ii + 1
  60.                 Application.StatusBar = Application.Text(Time - T, ["MM分SS秒"]) & " 共匯入上市月成交 " & ii & " 文字檔"
  61.             End If
  62.             Debug.Print IE.document.getelementsbytagname("TABLE").Length
  63.         Next E
  64.     IE.Quit
  65.     Application.StatusBar = Application.Text(Time - T, ["MM分SS秒"]) & " 共匯入上市月成交 " & ii & " 文字檔,  讀取完畢 !! "
  66.     MsgBox "匯入 文字檔" & ii & " 費時 " & Application.Text(Time - T, ["MM分SS秒"])
  67. '    ThisWorkbook.Save
  68. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
79#
發表於 2015-2-10 11:34 | 只看該作者
回復  smart3135
GBKEE 發表於 2014-5-26 17:13

GBKEE版主您好，去年有向您請教如何用迴圈抓取股市大量資料，幫助非常大，今年已經有新的年度資料，我想要抓取新的年度資料
但不知道為什麼去年度可以正常執行的VBA程式碼，到了今年卻會一直出錯，我嘗試新增、刪除、變更一些程式碼，但都無效
能不能請您再次幫忙看看程式碼有什麼問題嗎？感謝您！
上市年成交資訊.zip (22.07 KB)
出錯圖

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
80#
發表於 2015-2-10 17:29 | 只看該作者
回復 79# smart3135
  1. For Each E In Rng
  2.         With IE
  3.             Do While .Busy Or .ReadyState <> 4:    Loop
  4.             .Document.getelementbyid("STK_NO").Value = E
  5.             .Document.getelementSbyNAME("login_btn")(0).Click '按下查詢
  6.             Do While .Busy Or .ReadyState <> 4:    Loop
  7.             .Refresh  '網頁 需重新整理 ,才有資料下載
  8.             Do While .Busy Or .ReadyState <> 4:    Loop
  9.             Set a = .Document.getelementsbytagname("TABLE")
  10.             Do While a.Length <> 14:   Loop    '直到 a元素的子項目有14個
  11.             xFile = xPath & "\" & E & "\HPY.txt"
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
12345678910
返回列表 上一主題