IE Web 自动化 - 如何使用 Excel VBA/XML 宏自动 select 与单元格匹配的 Web 组合框值

Question

我是 VBA 的初学者，我在使用我的 Excel sheet 中的单元格值通过循环在网络组合框中自动选择国家/地区名称时遇到问题。如果有人可以帮助我修复我的 VBA 和 XMLHTTP 代码，那将会很有帮助。我的sheet和VBA代码如下，

Sheet,VBA代码,XML下面的代码,

1      PP #           Nationality   DOB           Work Permit Number
2      REDACTED       Indian        03/01/1978    ?
3                                                 ?
4                                                 ?
5                                                 ?


Sub MOLScraping()
Dim sht As Worksheet
Dim LastRow As Long

Set sht = ThisWorkbook.sheets("MOL")
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row

Dim IE As New InternetExplorer, HTML As HTMLDocument, post As Object, URL$

URL = "https://eservices.mol.gov.ae/SmartTasheel/Complain/IndexLogin?lang=en-gb"

For i = 2 To LastRow

With IE
    .Visible = True
    .navigate URL
    While .Busy = True Or .readyState <> 4: DoEvents: Wend
    Set HTML = .document

HTML.querySelector("button[ng-click='showEmployeeSearch()']").Click
Application.Wait Now + TimeValue("00:00:03")  ''If for some reason the script fails, make sure to increase the delay
    
    HTML.getElementById("txtPassportNumber").Value = sht.Range("C" & i)
                  
    HTML.getElementById("Nationality").Focus
    For Each post In HTML.getElementsByClassName("ng-scope")
        With post.getElementsByClassName("ng-binding")
            For i = 0 To .Length - 1
                If .Item(i).innerText = sht.Range("D" & i) Then ''you can change the country name here to select from dropdown
                    .Item(i).Click
                    Exit For
                End If
            Next i
        End With
    Next post
    HTML.getElementById("txtBirthDate").Value = sht.Range("E" & i)
    
    HTML.querySelector("button[onclick='SearchEmployee()']").Click
    
    HTML.getElementById("TransactionInfo_WorkPermitNumber").innerText = sht.Range("G" & i)
    
End With
Next x
End Sub


Sub Get_Data()
Dim res As Variant, QueryString$, ID$, Name$

QueryString = "{""PersonPassportNumber"":""REDACTED"",""PersonNationality"":""100"",""PersonBirthDate"":""01/01/1990""}"

With New XMLHTTP
    .Open "POST", "https://eservices.mol.gov.ae/SmartTasheel/Dashboard/GetEmployees", False
    .setRequestHeader "User-Agent", "Mozilla/5.0"
    .setRequestHeader "Content-Type", "application/json"
    .send QueryString
    res = .responseText
End With

ID = Split(Split(Split(res, "Employees"":")(1), "ID"":""")(1), """,")(0)
Name = Split(Split(Split(res, "Employees"":")(1), "OtherData2"":""")(1), """}")(0)

[A1] = ID: [B1] = Name
End Sub

Answer 1

评论：

这里有一个 selenium basic 的例子，它应该很容易适应循环，甚至可以为 Internet Explorer 重写。

如果您愿意，您可以尝试添加明确的等待时间（感谢@Topto 提醒我这些）。示例如下所示。显式等待、selenium 风格似乎不起作用的一种情况是使用 Passport #。这里我添加了一个循环，以确保在尝试更新之前显示它。

参考文献：

selenium basic 包装器是免费的。安装后你去 VBE > Tools > References > Selenium type library

待办事项：

这是为了演示原理。您可以轻松启动驱动程序，然后让您的循环从 sheet 中获取变量并发出新的 GET 请求。

代码：

Option Explicit

Public Sub MOLScraping()
    'Tools > references > selenium type library

    Dim d As New ChromeDriver                    '<== can change to other supported driver e.g. IE

    Const URL = "https://eservices.mol.gov.ae/SmartTasheel/Complain/IndexLogin?lang=en-gb"

    With d
        .Start
        .Get URL
        .FindElementByCss("button[ng-click='showEmployeeSearch()']").Click

         Do
             DoEvents
         Loop Until .FindElementById("txtPassportNumber").IsDisplayed

        .FindElementById("txtPassportNumber", timeout:=20000).SendKeys "123456"
        .FindElementById("Nationality").SendKeys "ALBANIA"
        .FindElementByCss("td.ng-binding").Click
        .FindElementById("txtBirthDate", timeout:=20000).SendKeys "12/01/20009"
        .FindElementByCss("td.active.day").Click
        .FindElementByCss("button[onclick*='SearchEmployee']").Click

        Stop

        'QUIT
    End With

End Sub

编辑

没有基于硒的答案（基于您引用的@SIM 的答案）

Option Explicit

Public Sub GetData()
    Dim res As Variant, QueryString As String, Permit As Long, Name As String, i As Long

    Dim passportNumber As String, personNationality As Long, birthdate As String

    Dim sht As Worksheet, lastRow As Long
    Set sht = ActiveSheet

    With sht
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
    End With

    For i = 2 To lastRow

        QueryString = "{""PersonPassportNumber"":""" & sht.Cells(i, 3) & """,""PersonNationality"":""" & sht.Cells(i, 4) & """,""PersonBirthDate"":""" & sht.Cells(i, 5) & """}"

        With CreateObject("MSXML2.serverXMLHTTP") 'New XMLHTTP60
            .Open "POST", "https://eservices.mol.gov.ae/SmartTasheel/Dashboard/GetEmployees", False
           ' .setRequestHeader "User-Agent", "Mozilla/5.0"
            .setRequestHeader "Content-Type", "application/json"
            .send QueryString
            res = .responseText
            Debug.Print res
        End With

        Permit = Replace(Split(Split(s, """OtherData"":""")(1), ",")(0), Chr$(34), vbNullString)
        Name = Split(Split(Split(res, "Employees"":")(1), "OtherData2"":""")(1), """}")(0)

        sht.Cells(i, 1) = Permit: sht.Cells(i, 2) = Name
    Next i
End Sub

IE Web 自动化 - 如何使用 Excel VBA/XML 宏自动 select 与单元格匹配的 Web 组合框值

IE Web Automation - How to auto select web combo box value matching with a cell using Excel VBA/XML Macro

vba

excel

web-scraping

browser-automation

webautomation

Sheet,VBA代码,XML下面的代码,

编辑