Board logo

標題: [發問] 請問如何捉取網頁要輸入的TABLE到表格，謝謝 [打印本頁]
作者: wufonna    時間: 2019-7-27 20:22     標題: 請問如何捉取網頁要輸入的TABLE到表格，謝謝

參考http://forum.twbts.com/viewthread.php?tid=9511
請問那裏錯，如果Date要用 NOW()取1200天如何改，謝謝
  1. Sub Ex()
  2.     Dim i As Integer, s As Integer, k As Integer, A, ii, j
  3.     Dim co_id As String, isnew As String, season As String
  4.                                     '第一季 01,第二季 02第三季 03,第四季 04.
  5.     With CreateObject("InternetExplorer.Application")
  6.         .Visible = True
  7.         .Navigate "https://www.cnyes.com/twstock/ps_historyprice/1216.htm"
  8.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  9.         With .document
  10.             For Each A In .getelementsbytagname("INPUT")
  11.                 If A.Name = "ctl00$ContentPlaceHolder1$startText" Then A.Value = "2016/06/01"
  12.             Next
  13.             For Each A In .getelementsbytagname("INPUT")
  14.                 If A.Name = "ctl00$ContentPlaceHolder1$endText" Then A.Value = "2019/07/27"
  15.             Next
  16.             For Each A In .getelementsbytagname("INPUT")
  17.                 If Trim(A.Value) = "查詢" And A.Name = "ctl00$ContentPlaceHolder1$submitBut" Then A.Click      '按下[查詢]鍵
  18.             Next
  19.             

  21.         End With
  22.         On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
  23.         Set A = .document.getelementsbytagname("table")(0).outerhtml
  24.         
  25.         With ActiveSheet
  26.             .Cells.Clear
  27.            '************************
  28.            ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
  29.            '******************************
  30.             For ii = 11 To A.Length - 1        ''從11開始 用 Debug.Print ii  找出所要資料的table範圍
  31.                 For i = 0 To A(ii).Rows.Length - 1      '寫入資料
  32.                 'Debug.Print ii  可找出所要資料的 table 範圍
  33.                 k = k + 1
  34.                 For j = 0 To 5
  35.                     Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
  36.                 Next
  37.             Next
  38.             Next
  39.    
  40.         End With
  41. '       .Quit        '關閉網頁
  42.     End With
  43. End Sub
  44. 'vba 操作ie匯入資料 'http://forum.twbts.com/viewthread.php?tid=9511
  45. '如何在網頁搜尋結果後，再按限時間按鈕
  46. '網頁登入-按鈕問題


  49. '<div class="mbx bd3" enableviewstate="false">
  50. '<h3 class="tabName"><span id="ctl00_ContentPlaceHolder1_titleLab">統一 歷史行情</span></h3>
  51. '<div class="blank10" enableviewstate="false"></div>
  52. '<span class="srchyear2" >
  53. '開始日期<input name="ctl00$ContentPlaceHolder1$startText" type="text" value="2016/06/01" maxlength="10" id="ctl00_ContentPlaceHolder1_startText" style="width:72px;" />
  54. '結束日期<input name="ctl00$ContentPlaceHolder1$endText" type="text" value="2019/07/27" maxlength="10" id="ctl00_ContentPlaceHolder1_endText" style="width:72px;" />
  55. '<input type="submit" name="ctl00$ContentPlaceHolder1$submitBut" value="查詢" id="ctl00_ContentPlaceHolder1_submitBut" class="butn btnga" />
  56. '    <span style="float:right">
  57. '</span>
  58. '</span>
複製代碼
作者: wufonna    時間: 2019-7-27 23:35

改這樣可行，但為什麼第二次執行會錯誤
  1. Sub Ex()
  2.     Dim i As Integer, s As Integer, k As Integer, A, ii, j
  3.     Dim co_id As String, isnew As String, season As String
  4.                                     '第一季 01,第二季 02第三季 03,第四季 04.
  5.     With CreateObject("InternetExplorer.Application")
  6.         .Visible = True
  7.         .Navigate "https://www.cnyes.com/twstock/ps_historyprice/1216.htm"
  8.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  9.         With .document
  10.             For Each A In .getElementsByTagName("INPUT")
  11.                 If A.Name = "ctl00$ContentPlaceHolder1$startText" Then A.Value = Format(Now - 1500, "yyyy/mm/dd") '"2016/06/01"
  12.             Next
  13.             For Each A In .getElementsByTagName("INPUT")
  14.                 If A.Name = "ctl00$ContentPlaceHolder1$endText" Then A.Value = Format(Now, "yyyy/mm/dd") '"2019/07/27"
  15.             Next
  16.             For Each A In .getElementsByTagName("INPUT")
  17.                 If Trim(A.Value) = "查詢" And A.Name = "ctl00$ContentPlaceHolder1$submitBut" Then A.Click      '按下[查詢]鍵
  18.             Next


  21.         End With
  22.     '    On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
  23.       Do While .Busy Or .ReadyState <> 4: DoEvents: Loop

  25.       
  26.      Set A = .document.getElementsByTagName("table")(0)
  27. '    On Error Resume Next

  29.         With ActiveSheet
  30.                 .Cells.Clear

  32.             For i = 0 To A.Rows.Length - 1

  34.                 For j = 0 To A.Rows(i).Cells.Length - 1

  36.                     .Cells(i + 1, j + 1) = A.Rows(i).Cells(j).innerText
  37. Debug.Print i
  38.                 Next

  40.             Next

  42.         End With

  44.         .Quit        '關閉網頁
  45.     End With
  46. End Sub
  47. 'vba 操作ie匯入資料 'http://forum.twbts.com/viewthread.php?tid=9511
  48. '如何在網頁搜尋結果後，再按限時間按鈕
  49. '網頁登入-按鈕問題


  52. '<div class="mbx bd3" enableviewstate="false">
  53. '<h3 class="tabName"><span id="ctl00_ContentPlaceHolder1_titleLab">統一 歷史行情</span></h3>
  54. '<div class="blank10" enableviewstate="false"></div>
  55. '<span class="srchyear2" >
  56. '開始日期<input name="ctl00$ContentPlaceHolder1$startText" type="text" value="2016/06/01" maxlength="10" id="ctl00_ContentPlaceHolder1_startText" style="width:72px;" />
  57. '結束日期<input name="ctl00$ContentPlaceHolder1$endText" type="text" value="2019/07/27" maxlength="10" id="ctl00_ContentPlaceHolder1_endText" style="width:72px;" />
  58. '<input type="submit" name="ctl00$ContentPlaceHolder1$submitBut" value="查詢" id="ctl00_ContentPlaceHolder1_submitBut" class="butn btnga" />
  59. '    <span style="float:right">
  60. '</span>
  61. '</span>
複製代碼
回復 1# wufonna



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)