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.Вы можете передать дату в качестве параметра строки запроса, а затем проанализировать ответ json с помощью jsonparser, например jsonconverter.bas .После добавления 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

---

Результаты: