麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 查找網站資料 [打印本頁]

作者: ciboybj 時間: 2014-7-23 22:52 標題: 依據EXCEL表中的名稱,利用IE開啟網頁進行查詢

大家好
我想請問要如何透過VBA
查詢以下網頁
http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPO.html
我有一個EXCEL的表，裡面有一欄是商品名稱
想請問各位要如何透過VBA將該欄的名稱依序打入網頁中查詢
並將查詢後的結果(網頁右方)回傳至EXCEL
PS, 我主要是要查詢我EXCEL中的名稱是否有出現在官網中

以上
再麻煩各位幫忙了
謝謝

作者: s90068 時間: 2014-7-26 23:50

可以上傳個「商品名稱欄」範例檔參考看看嗎?

作者: ciboybj 時間: 2014-7-27 14:07

s90068 您好
商品名稱例如下列
工業用酵素
工業用牛奶發酵劑
液晶
防腐劑
工業用除臭劑
工業用乾燥劑
中和劑
上述商品都可查到

在麻煩您了
謝謝您

作者: ciboybj 時間: 2014-8-3 00:28 標題: 查找網站資料

各位好
我利用論壇中之前版大的代碼進行部分修改後
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

複製代碼

想請各位幫忙看看
謝謝~

作者: ciboybj 時間: 2014-8-4 23:33

各位好
我利用下列程式貌似可將值send 到網站上,但是我不知道該如何把網站的資料抓回來
不知道是否有人能幫我看看

Sub jdj()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("msxml2.xmlhttp.3.0")
xmlhttp.Open "post", " http://tmsearch.tipo.gov.tw/TIPO_DR/servlet/InitGoodsIPOResult", False
xmlhttp.send " txtGoodsName=%A8F%A9%D4&txtGoodsID=&hdnGoodsNameLabel=%B0%D3%AB%7E%28%AAA%B0%C8%29%A6W%BA%D9&hdnGoodsIDLabel=%B0%D3%AB%7E%28%AAA%B0%C8%29%B2%D5%B8s%A5N%BDX"
If xmlhttp.readystate = 4 Then
MsgBox "done"
end if
end sub

複製代碼

謝謝

作者: GBKEE 時間: 2014-8-5 06:27

回復 5# ciboybj
試試看

Option Explicit
Sub Ex()
Dim D As Object, e As Object, URL As String
'工業用酵素
'工業用牛奶發酵劑
'液晶
'防腐劑
'工業用除臭劑
'工業用乾燥劑
'中和劑
URL = "http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPOContent.jsp"
With CreateObject("InternetExplorer.Application")
.Navigate URL
.Visible = True
Do While .ReadyState <> 4 Or .Busy
DoEvents
Loop
Set D = .document.all(6).all(0).contentWindow.frames.document.getElementsByTagName("INPUT")
D("txtGoodsName").Value = "中和劑"
For Each e In D
If e.Value = "查詢" Then e.Click: Exit For
Next
Do While .ReadyState <> 4 Or .Busy
DoEvents
Loop
Set D = .document.LastChild.LastChild.all(1).contentWindow.frames.document.getElementsByTagName("table")
Ep D(0).outerHTML
.Quit
End With
End Sub
Private Sub Ep(S As String)
With CreateObject("InternetExplorer.Application")
.Navigate "about:Tabs"
.Visible = True
.document.body.innerhtml = S
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet
.Cells.Clear
.Range("A1").Select
.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
End With
.Quit
End With
End Sub

複製代碼

作者: ciboybj 時間: 2014-8-5 23:09

GBKEE 您好
我在win 7 excel 2010 下執行時
出現執行階段錯誤438
偵錯指向下列程式碼
Set D = .document.LastChild.LastChild.all(1).contentWindow.frames.document.getElementsByTagName("table")
想請問您這要怎麼解決
ps 我另外在win xp excel2003中測試成功

再請您幫忙
謝謝您

作者: GBKEE 時間: 2014-8-6 06:22

回復 8# ciboybj
物件不支援此屬性或方法 (錯誤 438)
不好意思我只有2003版.無法替你修正

請修改6#的程式碼

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
'With CreateObject("InternetExplorer.Application")

複製代碼

有錯誤時請到如圖 IE物件找找 "table" 在哪裡

[attach]18834[/attach]

作者: joey0415 時間: 2014-8-6 21:11

本帖最後由 joey0415 於 2014-8-6 21:15 編輯

回復 ciboybj
試試看
GBKEE 發表於 2014-8-5 06:27

寫的真好！請問超版

Set D = .document.all(6).all(0).contentWindow.frames.document.getElementsByTagName("INPUT")

這句話的意思是有六個INPUT中的第一個子視窗將它設為物件嗎？

如果是的話，那下面這句
Set D = .document.LastChild.LastChild.all(1).contentWindow.frames.document.getElementsByTagName("table")
將右邊的TABLE的設為物件嗎？

左邊的叫.all(6).all(0).contentWindow.frames

右邊的叫.LastChild.LastChild.all(1).contentWindow.frames

為什麼右邊的不叫Set XXX = .document.all(1).all(0).contentWindow.frames.document.getElementsByTagName("table")

而且說上面的不是物件呢？是沒有還是寫錯呢？

請版主解說一下好嗎？還是有哪一個網頁可以參考！謝謝

作者: GBKEE 時間: 2014-8-7 06:12

回復 8# ciboybj
找了一下2010版試試看可改成如下

' Set D = .document.LastChild.LastChild.all(1).contentWindow.frames.document.getElementsByTagName("table")
Set D = .document.all(6).all(1).contentWindow.frames.document.getElementsByTagName("table")

複製代碼

回復 10# joey0415
Set D = .document.all(6).all(0).contentWindow.frames.document.getElementsByTagName("INPUT")
解釋如下
.document->HTML的[文件物件]
.All->document的element [元素集合]
all(6):排行第6位(下限索引值從0 開始)的[元素];.all(0)排行第0的[元素];
contentWindow屬性是指指定的frame或者iframe所在的window物件
getElementsByTagName("INPUT")->元素中的TagName為"INPUT"的集合物件

作者: joey0415 時間: 2014-8-7 20:24

回復 11# GBKEE

謝謝超版，研究網路抓取有一段時間了，這個網站我真的抓不到，所以看到超版的才知道有這麼回事

如下圖，六是這指個嗎？
[attach]18853[/attach]

我只看到網頁中有這些元素呀！
[attach]18854[/attach]

對於.document.all(6).all(0).

還真有些模糊

希望超版能多指點

謝謝

如果找到類似的網頁，再請超版來看看

作者: joey0415 時間: 2014-8-7 21:12

回復 11# GBKEE

請問超版，若抓用上市日報表的網站，左邊也是如此，table在右邊，修改超版的程式語法

Set D = .document.all(5).all(0).contentWindow.frames.document.getElementsByTagName("INPUT")
改成5才可以用

右邊的table若用下面的
Set D = .document.all(5).all(1).contentWindow.frames.document.getElementsByTagName("table")
則撈不到資料呢！
[attach]18858[/attach]
以下是日報表的程代碼

Sub 日報表()
Dim D As Object, e As Object, URL As String
URL = "http://bsr.twse.com.tw/bshtm/"
' URL = "http://tmsearch.tipo.gov.tw/TIPO_DR/GoodsIPOContent.jsp"
With CreateObject("InternetExplorer.Application")
.Navigate URL
.Visible = True
Do While .ReadyState <> 4 Or .Busy
DoEvents
Loop
Set D = .document
Stop
Set D = .document.all(5).all(0).contentWindow.frames.document.getElementsByTagName("INPUT")
' For Each ss In D
' MsgBox ss.Value
' Next
'
Stop
D("txtTASKNO").Value = "1101"
For Each e In D
If e.Value = "查詢" Then e.Click: Exit For
Next
Do While .ReadyState <> 4 Or .Busy
DoEvents
Loop
Set D = .document.all(5).all(1).contentWindow.frames.document.getElementsByTagName("table")
' Stop
' For Each ss In D
' MsgBox ss.innerHTML
' Next
Stop
Ep D(0).outerHTML
.Quit
End With
End Sub

複製代碼

====================================
剛剛試了原版主提出的網頁也是不知道超版說的是哪一個呢？

如圖
[attach]18856[/attach]

[attach]18857[/attach]

作者: GBKEE 時間: 2014-8-8 06:34

回復 13# joey0415

[attach]18860[/attach]

作者: joey0415 時間: 2014-8-8 07:56

回復 14# GBKEE

這張圖值五顆星啦！

改天我再來試試日報表改版主看看

請問版主找資料也是用這種方式呢？還是有別的更好的方式

vba內鍵的資料字型不能放大

謝謝

作者: GBKEE 時間: 2014-8-8 08:52

回復 15# joey0415

vba內建的資料字型不能放大

是這個嗎?

[attach]18861[/attach]

作者: ciboybj 時間: 2014-8-8 09:17

GBKEE 您好
真的很謝謝您
另外
想請問您有些查詢資料(例如查詢"電腦")會有下一頁的問題
想請教您此種狀況該如何解決
謝謝您

作者: GBKEE 時間: 2014-8-8 09:50

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

回復 17# ciboybj

有些查詢資料(例如查詢"電腦")會有下一頁的問題

哪要先看這網頁的原始文件 [下一頁]鍵的名稱.

Sub 日報表()
Dim D As Object, E As Object, P As Integer, URL As String, 頁數 As Integer, i As Integer
Dim P_down As Object
URL = "http://bsr.twse.com.tw/bshtm/"
With CreateObject("InternetExplorer.Application")
.Navigate URL
.Visible = True
Do While .readyState <> 4 Or .Busy
DoEvents
Loop
Set D = .Document.all(5).all(0).contentWindow.frames.Document.getelementsbytagname("INPUT")
D("txtTASKNO").Value = "1101"
For Each E In D
If E.Value = "查詢" Then E.Click: Exit For
Next
Do While .readyState <> 4 Or .Busy
DoEvents
Loop
頁數 = .Document.all(5).all(0).contentWindow.frames.Document.getElementsByName("sp_ListCount")(0).INNERTEXT
For Each E In .Document.all(5).all(0).contentWindow.frames.Document.getelementsbytagname("INPUT")
If E.Value = "下一頁" Then Set P_down = E: Exit For
Next
ActiveSheet.Cells.Clear
.Document.Focus
For P = 1 To 頁數
Set D = Nothing
Do
DoEvents
Set D = .Document.all(5).all(1).contentWindow.frames.Document.getelementsbytagname("table") '
Loop Until Not D Is Nothing And D.Length = 7
For i = IIf(P = 1, 3, 4) To 4
Ep D(i).outerHTML
Next
P_down.Click
Do While .readyState <> 4 Or .Busy
DoEvents
Loop
Next
.Quit
End With
End Sub
Private Sub Ep(s As String) ' A(A.Length - 1).outerHTML
With CreateObject("InternetExplorer.Application")
.Navigate "about:Tabs"
.Visible = True
.Document.body.innerHTML = s
.ExecWB 17, 2 ' Select All
.ExecWB 12, 2 ' Copy selection
With ActiveSheet
' MsgBox .UsedRange.Rows.Count
.Range("A" & IIf(.UsedRange.Rows.Count = 1, 1, .UsedRange.Rows.Count + 1)).Select
.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
End With
.Quit
End With
End Sub

複製代碼

作者: joey0415 時間: 2014-8-8 10:28

回復 16# GBKEE

我指的是「區域變數視窗」

請問版主還有更好的查找方法嗎？

作者: joey0415 時間: 2014-8-8 10:42

回復 18# GBKEE

謝謝超版解決這個問題！雖然我不是用這個方法抓的！不過還是要感謝

再請問超版

.Document.Focus

為什麼要這句呢？有什麼差別？

.all(5)的5我是一個一個試出來的

左邊的是frame是all(0)
右邊的是frame為什麼也是all(0)而不是all(1)
超版也是一個一個試出來的嗎？

還是有別的語法可以list出來呢？

感謝超版又學到東西

作者: GBKEE 時間: 2014-8-8 17:54

回復 20# joey0415

謝謝超版解決這個問題！雖然我不是用這個方法抓的！不過還是要感謝

可否PO上來交流.

.all(5)的5我是一個一個試出來的
超版也是一個一個試出來的嗎？
還是有別的語法可以list出來呢？

用IE語法讀取網頁資料,我也是網路上學來的

.Document.Focus
為什麼要這句呢？有什麼差別？

因該沒差別的,因程式有時會出錯,加上後很流暢.

右邊的是frame為什麼也是all(0)而不是all(1)

11# 有註明 all(6):排行第6位(下限索引值從0 開始)的[元素];.all(0)排行第0的[元素]

作者: ciboybj 時間: 2014-8-10 16:13

謝謝兩位的分享與教導~

作者: GBKEE 時間: 2014-8-12 20:50

回復 13# joey0415
給你參考

Option Explicit
Sub 股票日報表() '查詢單一股票
Dim 股票代號 As String, 頁數 As String, T As Date
Do While 股票代號 = ""
股票代號 = InputBox("股票代號", "輸入查詢之股票代號", "1101")
If 股票代號 = "" Then End
Loop
T = Time
頁數 = 報表頁數(股票代號)
If 頁數 <> "" Then
匯入日報表股票代號, 頁數
MsgBox Format(Time - T, "完成費時 HH:MM:SS")
Else
MsgBox "股票代號 " & 股票代號 & " 有誤 !!!"
End If
End Sub
Private Sub 匯入日報表(股票代號 As String, 頁數 As String) '參數傳送來的 --股票代號 & 頁數
Dim Rng As Range
With ActiveSheet
If .QueryTables.Count = 0 Then
With .QueryTables.Add("URL;about:Tabs", .[A1])
.Refresh BackgroundQuery:=False
End With
End If
With .QueryTables(1)
.Connection = "URl;http://bsr.twse.com.tw/bshtm/bsContent.aspx?StartNumber=" & 股票代號 & "&FocusIndex=All_" & 頁數
.WebFormatting = xlWebFormattingNone
.WebTables = "4,""table2"""
.Refresh False
End With
Set Rng = .UsedRange.Offset(6)
With Rng.Columns("A")
.Replace "序", "=Why", xlWhole
.SpecialCells(xlCellTypeFormulas, xlErrors).Value = ""
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
.Cells(1).Select
End With
End Sub
Private Function 報表頁數(股票代號 As String) '參數傳送來的 --股票代號
With CreateObject("InternetExplorer.Application")
.Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
Do While .Busy Or .readyState <> 4
DoEvents
Loop
.document.getElementsByName("txtTASKNO").Item(0).Value = 股票代號
.document.getElementsByName("btnOK")(0).Click
Do While .Busy Or .readyState <> 4
DoEvents
Loop
報表頁數 = .document.getElementsByName("sp_ListCount")(0).innertext
.Quit
End With
End Function

複製代碼

作者: joey0415 時間: 2014-8-13 08:47

回復 23# GBKEE

讚！謝謝版主用這麼功整的語法，小弟學習啦！

作者: cadillac 時間: 2014-8-13 23:02

回復 23# GBKEE

請問GBKEE大
執行時出現錯誤 , 該如何修正呢?

作者: GBKEE 時間: 2014-8-14 06:02

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

回復 25# cadillac

Private Function 報表頁數(股票代號 As String) '參數傳送來的 --股票代號
With CreateObject("InternetExplorer.Application")
.Navigate "http://bsr.twse.com.tw/bshtm/bsMenu.aspx"
Do While .Busy Or .readyState <> 4
DoEvents
Loop
'這裡沒錯誤 *****
.document.getElementsByName("txtTASKNO").Item(0).Value = 股票代號
.document.getElementsByName("btnOK")(0).Click '這裡為何沒錯誤???******
Do While .Busy Or .readyState <> 4
DoEvents
Loop
'可以自己改一改***********
報表頁數 = .document.getElementsByName("sp_ListCount")(0).innertext
.Quit
End With
End Function

複製代碼

作者: cadillac 時間: 2014-8-14 21:27

回復 26# GBKEE 超版

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

作者: cadillac 時間: 2014-8-14 21:40

回復 26# GBKEE 超版

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

作者: GBKEE 時間: 2014-8-15 05:56

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

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

你有查出網頁原始碼<span id="sp_ListCount">15</span>
試試看

.document.getElementByID("sp_ListCount").INNERTEXT

複製代碼

作者: cadillac 時間: 2014-8-18 22:00

回復 29# GBKEE 超版

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

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

作者: GBKEE 時間: 2014-8-19 06:51

回復 30# cadillac
23#不是有防錯機制,附上程式碼看看

If 頁數 <> "" Then
匯入日報表股票代號, 頁數
MsgBox Format(Time - T, "完成費時 HH:MM:SS")
Else
MsgBox "股票代號 " & 股票代號 & " 有誤 !!!"
End If

複製代碼

作者: rbktwi 時間: 2014-11-14 18:08

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

'          MsgBox ss.Value

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

作者: GBKEE 時間: 2014-11-15 16:30

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

回復 31# rbktwi

Set D = .document.all(5).all(1).contentWindow.frames.document.getElementsByTagName("table")
' D =>網頁文件中指定的元素"table" 物件
For Each ss In D '迴圈依序裡物件中的子物件
MsgBox ss.innerHTML ' innerHTML:子物件在網頁顯示的文字
'ss.Value 'Value: 子物件在網頁的值
'table" 物件有 innerHTML屬性,沒有Value屬性
Next

複製代碼

此段作用為何呢
可尋找所要的"table"資料

作者: 藍天麗池 時間: 2014-11-16 10:37

回復 32# GBKEE

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

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