- 帖子
- 47
- 主題
- 19
- 精華
- 0
- 積分
- 82
- 點名
- 0
- 作業系統
- win
- 軟體版本
- xp
- 閱讀權限
- 20
- 註冊時間
- 2014-7-4
- 最後登錄
- 2021-9-4
|
各位好
我利用論壇中之前版大的代碼進行部分修改後
http://forum.twbts.com/viewthread.php?tid=9511
以試圖於下列網站中的左欄輸入特定字串例如"沙拉油"
http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPO.html
然後進行查詢,並將查詢後右欄的表格貼回excel中
但是我的代碼卻無法順利輸入"沙拉油"
我的代碼如下- Sub Ex()
- Dim i As Integer, s As Integer, k As Integer, A, ii, j
- Dim txtGoodsName As String, isnew As String, season As String
- txtGoodsName = InputBox("請輸入 公司代號")
- ' If Not IsNumeric(Val(txtGoodsName)) Or Len(txtGoodsName) <> 4 Then Exit Sub '不是四位數的數字
- ' isnew = InputBox("1:最新資料，２:歷史資料" & vbLf & "請選 1 , 2")
- ' If isnew <> "1" And isnew <> "2" Then Exit Sub '沒選1 或 2
- ' If isnew = "2" Then season = InputBox("輸入年度 , 季別" & vbLf & "例 101,01")
- '第一季 01,第二季 02第三季 03,第四季 04.
- With CreateObject("InternetExplorer.Application")
- .Visible = True
- .Navigate "http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPO.html"
- Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
- With .document
- For Each A In .getelementsbytagname("INPUT")
- If A.Name = "txtGoodsName" Then A.Value = txtGoodsName
- 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 '按下[搜索]鍵
- If Trim(A.Value) = "查詢" 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
謝謝~ |
|
發表於 2014-7-23 22:52
| 
