返回列表 上一主題 發帖

請問這個網頁如何用WEB查詢輸入excel

回復 45# joey0415
參考:
  1. Sub 鉅享網()
  2.     Dim URL As String, shts As Worksheet
  3.     Dim x As Variant, xi As Integer
  4.    
  5.     Set shts = Sheets("工作表2")
  6.     URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
  7.    
  8.     With CreateObject("InternetExplorer.Application")
  9.         .Visible = True     '  是否顯示 IE
  10.         .Navigate URL
  11.         
  12.         shts.Cells.Clear
  13.         For xi = 1 To 6
  14.             Do While .readyState <> 4 Or .Busy
  15.                 DoEvents
  16.             Loop
  17.             
  18.             For Each x In .document.getElementsBytagname("input")
  19.                 If x.Value = "查詢" Then x.Click: Exit For
  20.             Next
  21.             
  22.             .document.body.innerHTML = .document.getElementsBytagname("table")(xi).outerHTML
  23.             .execwb 17, 2       '  Select All
  24.             .execwb 12, 2       '  Copy selection
  25.             
  26.             With shts
  27.                 .Range("A" & .[A65535].End(xlUp).Row + 1).Select
  28.                 .PasteSpecial Format:="HTML"
  29.             End With
  30.         Next xi
  31.         shts.Cells.EntireColumn.AutoFit     '  自動調整欄寬
  32.         
  33.         .Quit
  34.     End With
  35. End Sub
複製代碼

TOP

回復 54# GBKEE
原本我亦是如您所寫的 (For ~ Next) 方式處哩,但它在 2010 版大約在第二迴圈便會出現
錯誤訊息,所以只能將 For 往上擺放,每次都再執行 Click 的動作,一切便順心了。
看樣子就像統計圖表繪製有些語法處理之適用問題一樣,只能依版本見機行事,
謝謝您!

TOP

回復 56# GBKEE
只有一句話能形容    ----    Perfect!

TOP

回復 56# GBKEE
如果把 Set ie 以及 ie.Quit 改成註釋,則會發生如圖之錯誤:

TOP

回復 56# GBKEE
附上 54# 的程式執行結果:

TOP

回復 60# GBKEE
(如果把 Set ie 以及 ie.Quit 改成註釋)
附上測試用程式碼:
  1. Sub 鉅享網2()
  2.     Dim URL As String, shts As Worksheet, ie As Object
  3.     Dim x As Variant, A As Object
  4.    
  5.     '  Set ie = CreateObject("InternetExplorer.Application")
  6.     '  ie.Navigate "about:Tabs"
  7.     '  ie.Visible = True
  8.    
  9.     Set shts = ActiveSheet    '  Sheets("工作表2")
  10.     shts.Cells.Clear
  11.    
  12.     URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
  13.     With CreateObject("InternetExplorer.Application")
  14.         .Visible = True     '  是否顯示 IE
  15.         .Navigate URL
  16.         
  17.         Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  18.         
  19.         For Each x In .Document.getElementsBytagname("input")
  20.             If x.Value = "查詢" Then x.Click: Exit For
  21.         Next
  22.         
  23.         Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  24.         
  25.         Set A = .Document.getElementsBytagname("table")
  26.         For x = 1 To 6
  27.             '  With ie
  28.                 .Document.body.innerHTML = A(x).outerHTML
  29.                 .ExecWB 17, 2       '  Select All
  30.                 .ExecWB 12, 2       '  Copy selection
  31.             '  End With
  32.             
  33.             With shts
  34.                 .Range("A" & .[A65535].End(xlUp).Row + 1).Select
  35.                 .PasteSpecial Format:="HTML"
  36.             End With
  37.         Next
  38.         
  39.         shts.Cells.EntireColumn.AutoFit     '  自動調整欄寬
  40.         .Quit
  41.     End With
  42.    
  43.     '  ie.Quit
  44. End Sub
複製代碼

TOP

回復 60# GBKEE
我原本的測試程式碼:
  1. Sub 鉅享網3()
  2.     Dim URL As String, shts As Worksheet
  3.     Dim x As Variant, xi As Integer
  4.    
  5.     Set shts = ActiveSheet        '  Sheets("工作表2")
  6.     URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
  7.    
  8.     With CreateObject("InternetExplorer.Application")
  9.         .Visible = True     '  是否顯示 IE
  10.         .Navigate URL
  11.         
  12.         Do While .ReadyState <> 4 Or .Busy
  13.             DoEvents
  14.         Loop
  15.             
  16.         For Each x In .Document.getElementsBytagname("input")
  17.             If x.Value = "查詢" Then x.Click: Exit For
  18.         Next
  19.             
  20.         shts.Cells.Clear
  21.         For xi = 1 To 6
  22.             '  .document.body.innerHTML = .document.getElementsBytagname("table")(1).outerHTML
  23.             .Document.body.innerHTML = .Document.getElementsBytagname("table")(xi).outerHTML
  24.             .ExecWB 17, 2       '  Select All
  25.             .ExecWB 12, 2       '  Copy selection
  26.             
  27.             With shts
  28.                 '  .Cells.Clear
  29.                 .Range("A" & .[A65535].End(xlUp).Row + 1).Select
  30.                 .PasteSpecial Format:="HTML"
  31.                 '  .Cells.EntireColumn.AutoFit     '  自動調整欄寬
  32.             End With
  33.         Next xi
  34.         shts.Cells.EntireColumn.AutoFit     '  自動調整欄寬
  35.         
  36.         .Quit
  37.     End With
  38. End Sub
複製代碼

TOP

本帖最後由 c_c_lai 於 2013-11-22 07:36 編輯

回復 60# GBKEE
(圖中 與54# 的程式碼有點不樣)
附上執行之程式碼:
  1. Sub 鉅享網4()
  2.     Dim URL As String, shts As Worksheet
  3.     Dim x As Variant, xi As Integer, A As Object, xlHtm
  4.     Set shts = ActiveSheet '  '("工作表2")
  5.     shts.Cells.Clear
  6.     URL = "http://www.cnyes.com/twstock/Institutional/1101.htm"
  7.     With CreateObject("InternetExplorer.Application")
  8.         .Visible = True     '  是否顯示 IE
  9.         .Navigate URL
  10.          Do While .ReadyState <> 4 Or .Busy
  11.                 DoEvents
  12.             Loop
  13.         For Each x In .Document.getElementsBytagname("input")
  14.             If x.Value = "查詢" Then x.Click: Exit For
  15.         Next
  16.         Do While .ReadyState <> 4 Or .Busy: DoEvents: Loop
  17.         xlHtm = .Document.body.innerHTML                '儲存
  18.         Set A = .Document.getElementsBytagname("table")
  19.         For xi = 1 To 6
  20.             .Document.body.innerHTML = A(xi).outerHTML
  21.             .ExecWB 17, 2       '  Select All
  22.             .ExecWB 12, 2       '  Copy selection
  23.             With shts
  24.                 .Range("A" & .[A65535].End(xlUp).Row + 1).Select
  25.                 .PasteSpecial Format:="HTML"
  26.             End With
  27.             .Document.body.innerHTML = xlHtm                  '還原
  28.         Next xi
  29.         shts.Cells.EntireColumn.AutoFit     '  自動調整欄寬
  30.         .Quit
  31.     End With
  32. End Sub
複製代碼

P.S.     這是剛才才執行出來的決果。

TOP

回復 65# GBKEE
(56#的程式碼在空白網頁放置 "table"的寫法)
我將 "空白網頁" 隱藏起來視覺上清爽多了。
  1.     Set ie = CreateObject("InternetExplorer.Application")
  2.     ie.Navigate "about:Tabs"
  3.     '  ie.Visible = True
複製代碼
執行決果一切 OK。

TOP

回復 68# GBKEE
說的也是!
謝謝指導。

TOP

        靜思自在 : 道德是提昇自我的明燈,不該是呵斥別人的鞭子。
返回列表 上一主題