網頁查詢問題

sillykin

網頁查詢碰到要輸入關鍵字,在查詢,結果可否用選擇的方式,選擇正確在放入EXCEL表格內呢?

sillykin

Option Explicit
Dim IE As Object, Combo_Ar(), xMsg As Boolean, xButton As Boolean, xRng As Range

Private Sub Label6_Click()

End Sub

Private Sub UserForm_Initialize()
    'ComboBox 控制項 -> 縣市'事務所名稱 '鄉鎮市區'段'小段
    Combo_Ar = Array(ComboBox0, ComboBox1, ComboBox2)
    Set IE = CreateObject("InternetExplorer.Application")
    Set xRng = [B36    ]
   ' Label1 = ""
    xRng.Resize(, ６) = ""
    With IE
        '.Visible = True '可不顯示IE
        .Navigate "http://lisp.land.moi.gov.tw/MMS/MMSpage.aspx#gobox03"
        Do While .Busy Or .readyState <> 4: DoEvents: Loop
        ComboBox_list 0
    End With
End Sub
Private Sub ComboBox_list(ByVal Op As Integer)
    '縣市'事務所名稱 '鄉鎮市區'段'小段 的選項內容導入ComboBox的list
    Dim xSelect As Object, i As Integer, x As Integer
    xMsg = True
    'xButton = True
    For i = Op To UBound(Combo_Ar)
        With Combo_Ar(i)
            If i = Op And .ListCount = 0 Then
                Do
                    Set xSelect = IE.Document.all.tags("SELECT")(i)
                Loop Until xSelect.Length > 0
              ' MsgBox .List(1)
                For x = 0 To xSelect.Length - 1
                    .AddItem
                    .List(.ListCount - 1, 0) = xSelect(x).innertext
                Next
                .ListIndex = 0
            ElseIf i = Op And .ListIndex > 0 Then
                Do
                    Set xSelect = IE.Document.all.tags("SELECT")(i)
                Loop Until xSelect.Length > 0
                xSelect.selectedIndex = .ListIndex
                If Op <> UBound(Combo_Ar) Then
                    xSelect.fireEvent ("onchange")
                    Do While IE.Busy Or IE.readyState <> 4: DoEvents: Loop
                    Do
                        Set xSelect = IE.Document.all.tags("SELECT")(i + 1)
                    Loop Until xSelect.Length > 0
                    With Combo_Ar(i + 1)
                        .Clear
                        For x = 0 To xSelect.Length - 1
                            .AddItem
                            .List(.ListCount - 1, 0) = xSelect(x).innertext
                        Next
                        .ListIndex = 0
                    End With
                End If
            ElseIf i > 0 Then
                If Combo_Ar(i - 1).ListIndex = 0 Or Combo_Ar(i - 1).ListCount = 0 Then
                    .Clear
                End If
            End If
            If .ListCount = 0 Or .ListIndex = 0 Then xButton = False
            If UBound(Combo_Ar) = i And .ListCount > 0 Then
                If .ListCount = 2 And .List(1) = "" Then xButton = True
                If .ListCount = 2 And .List(1) <> "" And .ListIndex > 0 Then xButton = True
                If .ListCount > 2 And .ListIndex > 0 Then xButton = True
            End If
        End With
    Next
    If xButton Then
        button_Click
    Else
        xRng.Cells(1, 6) = ""
        'Label1 = ""
    End If
    xMsg = False
End Sub
Private Sub ComboBox0_Change()      '縣市
     If xMsg = False Then ComboBox_list 0
     xRng.Cells(1, 2) = ComboBox0.Value
End Sub
Private Sub ComboBox1_Change()      '事務所名稱
    If xMsg = False Then ComboBox_list 1
    xRng.Cells(1, 3) = ComboBox1.Value
End Sub
Private Sub ComboBox2_Change()      '鄉鎮市區
    If xMsg = False Then ComboBox_list 2
    xRng.Cells(1, 4) = ComboBox2.Value
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    IE.Quit
End Sub
Private Sub button_Click() '查詢
    Dim xIObject As Object, E
    With IE
        Do
            Set xIObject = .Document.all.tags("INPUT")
        Loop Until Not xIObject Is Nothing
        For Each E In xIObject
            If E.Value = "查詢" And E.Type = "button" Then
                E.Click
                Exit For
            End If
        Next
        Do While .Busy Or .readyState <> 4: DoEvents: Loop
        Do
            Set xIObject = .Document.all.tags("STRONG")(0)
        Loop Until Not xIObject Is Nothing
    End With
    E = xIObject.innertext
    'Label1 = Split(xIObject.innertext, "：")(1)
    xRng.Cells(1, 1) = "'" & Split(xIObject.innertext, "：")(1)
    Label8 = Split(xIObject.innertext, "：")(1)
End Sub
目前只能抓到第一個值,但第二、三個值抓不到，不知那位大大能幫忙，感恩

n7822123

回復 2# sillykin


目前只能抓到第一個值,但第二、三個值抓不到，不知那位大大能幫忙，感恩

你好像抓錯選單序號了，應該是抓第7、8、9 個選單，才符合你Excel內的貼圖

你可以用Google瀏覽器 的"檢查"，來確認ID(下圖)，

再用以下程式碼 確認 第N個下拉選單的ID，避免抓錯!

下載 (58.23 KB)

2020-7-4 21:46

Sub 確認各選單的序號與ID對應()
With CreateObject("InternetExplorer.Application")
    '.Visible = True '可不顯示IE
    .Navigate "http://lisp.land.moi.gov.tw/MMS/MMSpage.aspx#gobox03"
    Do While .Busy Or .readyState <> 4: DoEvents: Loop
    With .Document.all.tags("SELECT")
        For i = 0 To .Length - 1
            Debug.Print i & ": " & .Item(i).ID
        Next
    End With
    .Quit
End With
End Sub

此下拉選單原件有用 javaScript 寫"change"事件的腳本

此腳本是用來塞下一個下拉選單的"選項"

也就是說，你必須用IE填寫第一個元件的值，並觸發第一個元件腳本

第二個元件才會有下拉選單的值給你抓到表單~~~~~~

下載 (209.65 KB)

2020-7-4 21:52

下載 (75.87 KB)

2020-7-4 21:52

sillykin

回復 3# n7822123
感謝n7822123老師的回覆..
但小弟對 javaScript 寫"事件的腳本不太懂
小弟在慢慢研究.....

n7822123

回復 4# sillykin


寫程式讓它觸發原本網頁的腳本事件就好了.............

不是要你研究 javascript.......

你原本寫的 ComboBox_list 程序 有點複雜，看不太懂你要幹嘛

我自己寫了2個程序GetCB_OP、WbKeyin_OP 取代他，ComboBox 我改編號 為7、8、9 對應網頁的編號

這樣我寫程式比較順手，你再試看看~~

抓地網頁地段.rar (966.46 KB)

下載次數: 21

2020-7-5 23:50

n7822123

回復 5# n7822123


剛剛發現表單操作過快會取不到資料，

請自行新增一行程式


Private Sub ComboBox7_Change()      '縣市
     'If xMsg = False Then ComboBox_list 0
     xRng.Cells(1, 2) = ComboBox7.Value
     WbKeyin_OP 7          '輸入資料到WB第7個選單、並觸發事件
     Application.Wait (Now + TimeValue("00:00:01"))   '等待，過快會取不到資料
     GetCB_OP 8               '取得WB第8個選單資料
End Sub
Private Sub ComboBox8_Change()      '事務所名稱
    'If xMsg = False Then ComboBox_list 1
    xRng.Cells(1, 3) = ComboBox8.Value
    WbKeyin_OP 8          '輸入資料到WB第8個選單、並觸發事件
    Application.Wait (Now + TimeValue("00:00:01"))   '等待，過快會取不到資料
    GetCB_OP 9               '取得WB第9個選單資料
End Sub
Private Sub ComboBox9_Change()      '鄉鎮市區
    'If xMsg = False Then ComboBox_list 2
    xRng.Cells(1, 4) = ComboBox9.Value
    WbKeyin_OP 9          '輸入資料到WB第9個選單、並觸發事件    =>這個漏寫了
End Sub

sillykin

感謝老師的協助，小弟在試一試，在此感謝

sillykin

n7822123老師
下載檔案無法打開,能否在重傳呢？？

sillykin

文件巳下載(可能在操作上有操作錯誤),在此說一聲抱歉
文件操作上沒什麼問題,感謝老師大力的幫忙,目前還有一小問題
就是『關鍵字』輸入查詢問題,可否指引一個方向

n7822123

回復 9# sillykin


其實我比較推薦 "段代碼" 因為是"唯一"的，搜出來只會有1筆

用關鍵字可能搜出來有很多筆~如你的竹圍就有5筆，如果你要全部列出來

可能要先判斷搜出來有幾頁，因這個網站超過10筆會進下一頁

你需要寫程式控制IE，去點選頁數，讓它觸發更新，再下載10筆，再控制IE點第2頁，在下載下10筆.......

想想就覺得很麻煩~~~我完全不會想這樣寫