返回列表 上一主題 發帖

[發問] 查找網站資料

[發問] 查找網站資料

各位好
我利用論壇中之前版大的代碼進行部分修改後
http://forum.twbts.com/viewthread.php?tid=9511
以試圖於下列網站中的左欄輸入特定字串例如"沙拉油"
http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPO.html
然後進行查詢,並將查詢後右欄的表格貼回excel中
但是我的代碼卻無法順利輸入"沙拉油"
我的代碼如下
  1. Sub Ex()
  2.     Dim i As Integer, s As Integer, k As Integer, A, ii, j
  3.     Dim txtGoodsName As String, isnew As String, season As String
  4.     txtGoodsName = InputBox("請輸入 公司代號")
  5.        ' If Not IsNumeric(Val(txtGoodsName)) Or Len(txtGoodsName) <> 4 Then Exit Sub              '不是四位數的數字
  6.    ' isnew = InputBox("1:最新資料,2:歷史資料" & vbLf & "請選 1 , 2")
  7.    ' If isnew <> "1" And isnew <> "2" Then Exit Sub                              '沒選1 或 2
  8.    ' If isnew = "2" Then season = InputBox("輸入年度 , 季別" & vbLf & "例 101,01")
  9.                                     '第一季 01,第二季 02第三季 03,第四季 04.
  10.     With CreateObject("InternetExplorer.Application")
  11.         .Visible = True
  12.         .Navigate "http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPO.html"
  13.                 Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  14.         With .document
  15.             For Each A In .getelementsbytagname("INPUT")
  16.                             If A.Name = "txtGoodsName" Then A.Value = txtGoodsName
  17.                        Next
  18.           '  For Each A In .getelementsbytagname("SELECT")
  19.            '     If A.Name = "isnew" Then
  20.           '          A.Value = True
  21.             '        If isnew = "2" Then
  22.              '           A.Focus
  23.               '          Application.Wait Now + #12:00:02 AM#
  24.                '         Application.SendKeys "{DOWN}"
  25.                 '        Application.Wait Now + #12:00:02 AM#
  26.                  '       Application.SendKeys "{ENTER}"
  27.                   '  End If
  28.                ' End If
  29.                 'If A.Name = "year" And isnew = "2" Then A.Value = Split(season, ",")(0)
  30.                ' If A.Name = "season" And isnew = "2" Then A.Value = Split(season, ",")(1)
  31.            ' Next
  32.                     For Each A In .getelementsbytagname("INPUT")
  33.                                'If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click        '按下[搜索]鍵
  34.                        If Trim(A.Value) = "查詢" Then A.Click         '按下[搜索]鍵
  35.                     Next
  36.             End With
  37.         Application.Wait Now + #12:00:10 AM#                     '等待網頁下載資料
  38.         Set A = .document.getelementsbytagname("table")
  39.         On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
  40.         With ActiveSheet
  41.             .Cells.Clear
  42.            '************************
  43.            ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
  44.            '******************************
  45.             For ii = 11 To A.Length - 1        ''從11開始 用 Debug.Print ii  找出所要資料的table範圍
  46.                 For i = 0 To A(ii).Rows.Length - 1      '寫入資料
  47.                 'Debug.Print ii  可找出所要資料的 table 範圍
  48.                 k = k + 1
  49.                 For j = 0 To 5
  50.                     Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
  51.                 Next
  52.             Next
  53.             Next
  54.             .Range("C5").Cut Range("D5")
  55.             With .Range("B5:C5,D5:E5")
  56.                 .HorizontalAlignment = xlCenter
  57.                 .VerticalAlignment = xlCenter
  58.                 .Merge
  59.             End With
  60.         End With
  61.        '.Quit        '關閉網頁
  62.     End With
  63. End Sub
複製代碼
想請各位幫忙看看
謝謝~

回復 32# GBKEE

G大可以幫我一下嗎??感謝
    http://forum.twbts.com/thread-12797-1-1.html

TOP

本帖最後由 GBKEE 於 2014-11-15 16:32 編輯

回復 31# rbktwi
  1. Set D = .document.all(5).all(1).contentWindow.frames.document.getElementsByTagName("table")
  2.         ' D =>網頁文件中指定的元素"table" 物件
  3.         For Each ss In D   '迴圈 依序裡物件中的子物件
  4.             MsgBox ss.innerHTML   ' innerHTML:子物件在網頁顯示的文字
  5.                   'ss.Value   'Value: 子物件在網頁的值
  6.                   'table" 物件 有 innerHTML屬性,沒有Value屬性
  7.         Next
複製代碼
此段作用為何呢
可尋找所要的"table"資料
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

超版您好
請教以下問題
有關12#語法中
'        For Each ss In D

'            MsgBox ss.Value

'        Next
此段作用為何呢? 感謝解答

TOP

回復 30# cadillac
23#不是有防錯機制,附上程式碼看看
  1. If 頁數 <> "" Then
  2.         匯入日報表 股票代號, 頁數
  3.        MsgBox Format(Time - T, "完成 費時 HH:MM:SS")
  4.     Else
  5.         MsgBox "股票代號  " & 股票代號 & " 有誤 !!!"
  6.     End If
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 29# GBKEE 超版

感謝版大的幫忙 , 程式都可以正常跑完.

另外請教版大在抓取頁數的時候如果出現 "執行階段錯誤13 : 型態不符合"
可以用程式自動確認然後繼續執行嗎?

ScreenHunter_02 Aug. 18 21.04.jpg (13.53 KB)

錯誤訊息

ScreenHunter_02 Aug. 18 21.04.jpg

ScreenHunter_04 Aug. 18 21.04.jpg (32.49 KB)

錯誤畫面

ScreenHunter_04 Aug. 18 21.04.jpg

TOP

本帖最後由 GBKEE 於 2014-8-15 06:35 編輯

回復 28# cadillac
網頁設有[認證碼],限制用程式下載.功力不夠破解不了.

你有查出網頁原始碼<span id="sp_ListCount">15</span>
試試看
  1. .document.getElementByID("sp_ListCount").INNERTEXT            
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 26# GBKEE 超版

附上檔案
另外請問 "下載一般交易買賣日報表 CSV" , 有機會強制鎖定 "認證碼"數值 , 然後自動填入認證碼進行下載csv檔嗎?

ScreenHunter_02 Aug. 14 21.37.jpg (117.68 KB)

下載一般交易買賣日報表 CSV

ScreenHunter_02 Aug. 14 21.37.jpg

每日交易明細報表Ver 0.1.rar (28.24 KB)

TOP

回復 26# GBKEE 超版

試了好久還是試不出來,
加入.Visible = True 叫出IE查看 , 確認是有查詢到頁碼 , 但是程式就是沒法繼續往下走 , 懇請超版幫幫忙 , 感恩.

ScreenHunter_02 Aug. 14 21.16.jpg (31.25 KB)

程式碼斷點

ScreenHunter_02 Aug. 14 21.16.jpg

ScreenHunter_02 Aug. 14 21.21.jpg (13.4 KB)

錯誤訊息

ScreenHunter_02 Aug. 14 21.21.jpg

ScreenHunter_02 Aug. 14 21.20.jpg (69.93 KB)

IE 檢查元素

ScreenHunter_02 Aug. 14 21.20.jpg

TOP

本帖最後由 GBKEE 於 2014-8-14 09:41 編輯

回復 25# cadillac
  1. Private Function 報表頁數(股票代號 As String)   '參數傳送來的 --股票代號
  2.     With CreateObject("InternetExplorer.Application")
  3.             .Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
  4.             Do While .Busy Or .readyState <> 4
  5.                 DoEvents
  6.             Loop
  7.             '這裡沒錯誤 *****
  8.             .document.getElementsByName("txtTASKNO").Item(0).Value = 股票代號         
  9.          .document.getElementsByName("btnOK")(0).Click    '這裡為何沒錯誤???******
  10.             Do While .Busy Or .readyState <> 4
  11.                 DoEvents
  12.             Loop
  13.             '可以自己 改一改***********
  14.             報表頁數 = .document.getElementsByName("sp_ListCount")(0).innertext
  15.             .Quit
  16.     End With
  17. End Function
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題