Excel Vba IE_automate：如何觸發下拉列表中的更改

Question

Excel Vba IE_automate：如何觸發下拉列表中的更改

請訪問網頁www.twse.com.tw/zh/page/trading/fund/MI_QFIIS.html www.twse.com.tw/zh/page/trading/fund/MI_QFIIS.html

第一個下拉列表=年

第二個下拉列表=月

第三個下拉列表=天

如果我手動將第二個下拉列表的值（月份從02更改為01），則第三個下拉列表的值將自動更改為01。（每月的第一天）

但是，如果我使用以下代碼。 第三個dropdonw列表的值不會更改。 我嘗試了t.fireevent（“ onchange”），但是沒有用

Sub Getvaule()
   Set ie = CreateObject("internetexplorer.application")
   ie.Visible = True
   ie.navigate ("http://www.twse.com.tw/zh/page/trading/fund/MI_QFIIS.html") 
   While ie.readystate <> 4 Or ie.busy
   Wend

   For Each t In ie.document.getElementsByTagName("select")
     If Trim(t.Name) = "mm" Then
         t.Value = "1"                   
         While ie.readystate <> 4 Or ie.busy
         Wend
     End If
   Next
End Sub

編輯。 sendkeys_example供參考

Sub sendkeys_example()
Dim ie, x

Set x = CreateObject("wscript.shell")
Set ie = CreateObject("InternetExplorer.Application")

ie.Navigate "http://www.twse.com.tw/zh/page/trading/fund/MI_QFIIS.html"
ie.Visible = 1
ie.Toolbar = 0    
While ie.readystate <> 4 Or ie.Busy
Wend

x.SendKeys "{tab 4}", True
x.SendKeys "{down}"
End Sub

Answer 1

我會完全避免使用瀏覽器，而使用xmlhttp請求。 您可以將日期作為查詢字符串參數傳遞，然后使用jsonparser（例如jsonconverter.bas）解析json響應。 將jsonconverter.bas添加到您的項目后，您需要轉到VBE > Tools > References > Add a reference to Microsoft Scripting Runtime 。

只需將date=20180104更改為所需的日期並連接到請求url中即可。

Public Sub GetInfo()
    Dim url As String, json As Object, headers(), fields As Object
    Dim data As Object, item As Object, results(), r As Long, c As Long

    url = "http://www.twse.com.tw/fund/MI_QFIIS?response=json&date=20180103&selectType=01&_=1550397583207"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With

    Set fields = json("fields")
    Set data = json("data")

    ReDim headers(1 To fields.Count)
    ReDim results(1 To data.Count, 1 To fields.Count)

    For i = 1 To fields.Count
        headers(i) = fields(i)
    Next
    For Each item In data
        r = r + 1: c = 1
        For Each DataField In item
            results(r, c) = DataField
            c = c + 1
        Next
    Next
    With ThisWorkbook.Worksheets("Sheet1")
        .Cells(1, 1).Resize(1, UBound(headers)) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

---

結果：