Question

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

表格，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提醒我这些）。示例如下所示。明确等待，硒风格似乎不起作用的一个案例是使用Passport＃。在这里，我添加了一个循环，以确保在尝试更新之前显示它。

<强>参考文献：

selenium basic包装器是免费的。安装完成后，你去VBE＆gt;工具＆gt;参考文献＆gt; Selenium类型库

<强> TODO：

这是为了证明校长。您可以轻松启动驱动程序，然后让循环从工作表中获取变量并发出新的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 Automation - 如何使用Excel VBA / XML宏自动选择与单元格匹配的Web组合框值

表格，VBA代码，下面的XML代码，

1 个答案:

修改