从下拉菜单中选择

时间:2018-03-06 19:46:39

标签: vba drop-down-menu

我正在尝试在网页中运行一组查询。初始查询定义DropDownList1是否具有多个选项。选择其他选项会重新加载Web表单。 当我运行以下部分时,下拉列表中的任何内容都不会更改。如果我跳过... FireEvent ...行,下拉菜单的值在循环期间会发生变化,但Web表单不会重新加载,并且会为所有列表元素返回初始值。

Set dd1 = doc.getElementById("DropDownList1")
If dd1.Options.Length > 1 Then
  For Each opt In dd1.Options
    doc.getElementById("DropDownList1").Focus
    doc.getElementById("DropDownList1").selectedIndex = opt.Index
    doc.getElementById("DropDownList1").FireEvent ("onchange")

    ''copy the elements' values in excel sheet
  next opt
end if

你知道我缺少什么吗?

这是整个代码:

Sub addresses()

Dim evt As Object
Dim doc As Object
Dim IE As Object
Dim Form As Object
Dim ID As Object
Dim Name As Object
Dim address As Object
Dim CForm As Object
Dim Code As Object
Dim Activity As Object
Dim NKD_2007 As Object
Dim NKD_2002 As Object
Dim dd1 As Object
Dim i, j As Integer
Dim sh, exp As String

sh = "Sheet6" ''read sheet
exp = "Sheet7" ''export sheet

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https://www.dzs.hr/app/kalendar/RPSByCode.aspx"
While IE.Busy Or IE.ReadyState <> 4
 DoEvents
Wend
j = 2
 Set doc = IE.Document
 Set Form = doc.forms("form1")
 Set ID = doc.getElementById("TextBox1")
 ID.Value = "01487434" ''ID VALUE
 Form.submit
 While IE.Busy Or IE.ReadyState <> 4
  DoEvents
 Wend
 On Error Resume Next
 Set Name = doc.getElementById("DataList1_ctl01_NazivLbl")
 Set address = doc.getElementById("DataList1_ctl01_AdresaLbl")
 Set CForm = doc.getElementById("DataList1_ctl01_PUONazivLbl")
 Set Code = doc.getElementById("DataList1_ctl01_Label1")
 Set Activity = doc.getElementById("DataList1_ctl01_Label2")
 Set NKD_2007 = doc.getElementById("DataList1_ctl01_Label3")
 Set NKD_2002 = doc.getElementById("DataList1_ctl01_Label4")
 Set dd1 = doc.getElementById("DropDownList1")

 ''filling the table
 Sheets(exp).Cells(j, 2) = Name.innertext
 Sheets(exp).Cells(j, 3) = address.innertext
 Sheets(exp).Cells(j, 4) = CForm.innertext
 Sheets(exp).Cells(j, 5) = Code.innertext
 Sheets(exp).Cells(j, 6) = Activity.innertext
 Sheets(exp).Cells(j, 7) = NKD_2007.innertext
 Sheets(exp).Cells(j, 8) = NKD_2002.innertext

 j = j + 1

 If dd1.Options.Length > 1 Then
  For Each opt In dd1.Options
     On Error Resume Next         
     IE.Document.getElementById("DropDownList1").selectedIndex = opt.Index
     IE.Document.getElementById("DropDownList1").FireEvent ("onchange")

     Set Name = IE.Document.getElementById("DataList2_ctl01_NazivLbl")
     Set address = doc.getElementById("DataList2_ctl01_AdresaLbl")
     Set Activity = doc.getElementById("DataList2_ctl01_Label2")
     Set NKD_2007 = doc.getElementById("DataList2_ctl01_Label3")
     Set NKD_2002 = doc.getElementById("DataList2_ctl01_Label4")

     Sheets(exp).Cells(j, 2) = Name.innertext
     Sheets(exp).Cells(j, 3) = address.innertext
     Sheets(exp).Cells(j, 4) = CForm.innertext
     Sheets(exp).Cells(j, 5) = Code.innertext
     Sheets(exp).Cells(j, 6) = Activity.innertext
     Sheets(exp).Cells(j, 7) = NKD_2007.innertext
     Sheets(exp).Cells(j, 8) = NKD_2002.innertext

     j = j + 1
  Next opt
 End If

 Set doc = Nothing
 Set Form = Nothing
 Set Name = Nothing
 Set address = Nothing
 Set CForm = Nothing
 Set Code = Nothing
 Set Activity = Nothing
 Set NKD_2007 = Nothing
 Set NKD_2002 = Nothing

IE.Quit
Set IE = Nothing
End Sub

提前致谢

1 个答案:

答案 0 :(得分:0)

我发现了问题。这行没有正常工作: IE.Document.getElementById(&#34; DropDownList1&#34;)。selectedIndex = opt.Index

我不知道为什么在FireEvent或表单提交后对象dd1丢失了它的元素。使用 IE.Document.getElementById(&#34; DropDownList1&#34;)。Value = string_from_previously_assigned_array 并重新提交表单导致工作代码。