IE网页自动化：如何用Excel VBA/XML宏匹配单元格值选网页下拉框

I see you're a VBA beginner trying to automate checking UAE MOL employee records by looping through Excel rows, selecting nationalities from a dropdown, and scraping data. Let's walk through fixing your code step by step—there are several small issues causing it to fail, plus some improvements to make it more reliable.

First, Let's List the Key Issues in Your Original Code #

• Loop variable conflict: You used i for both the outer row loop and inner dropdown option loop—this breaks your row tracking entirely.
• Incorrect cell references: Some range calls (like sht.Range("D" & i) inside the inner loop) point to the wrong rows because of the variable mix-up.
• Inefficient IE usage: Initializing a new IE instance inside the row loop opens multiple windows and slows down the process drastically.
• Unreliable waiting: Fixed 3-second waits can fail if the page loads slower; we should wait for specific elements to appear instead.
• Backwards data assignment: You tried to write Excel values to the webpage's work permit field instead of pulling the scraped value into Excel.
• Fragile JSON parsing: Using nested Split() calls to parse JSON is error-prone—we'll use a more robust approach (or recommend a dedicated JSON library for better scalability).
• LastRow calculation: SpecialCells(xlCellTypeLastCell) can return incorrect rows if there are formatted empty cells; we'll use a more reliable method.

Fixed MOLScraping Subroutine (IE-Based) #

Sub MOLScraping()
    Dim sht As Worksheet
    Dim LastRow As Long, i As Long
    Dim IE As InternetExplorer
    Dim HTML As HTMLDocument
    Dim nationalityDropdown As Object, opt As Object
    Dim URL As String
    
    ' Set worksheet and get last row with data in column C (Passport Number)
    Set sht = ThisWorkbook.Sheets("MOL")
    LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
    
    ' Initialize IE once outside the loop (faster, cleaner)
    Set IE = New InternetExplorer
    IE.Visible = True
    URL = "https://eservices.mol.gov.ae/SmartTasheel/Complain/IndexLogin?lang=en-gb"
    
    For i = 2 To LastRow
        ' Navigate to the page and wait for full load
        IE.Navigate URL
        Do While IE.Busy Or IE.ReadyState <> 4
            DoEvents
        Loop
        Set HTML = IE.Document
        
        ' Click "Employee Search" button and wait for the form to load
        HTML.querySelector("button[ng-click='showEmployeeSearch()']").Click
        Do While HTML.getElementById("txtPassportNumber") Is Nothing
            DoEvents
        Loop
        
        ' Fill passport number from Excel
        HTML.getElementById("txtPassportNumber").Value = sht.Range("C" & i).Value
        
        ' Handle nationality dropdown correctly
        Set nationalityDropdown = HTML.getElementById("Nationality")
        nationalityDropdown.Focus
        ' Loop through dropdown options to match the Excel country name
        For Each opt In nationalityDropdown.Options
            If opt.Text = sht.Range("D" & i).Value Then
                opt.Selected = True
                Exit For
            End If
        Next opt
        
        ' Fill birth date (format to match the site's expected dd/mm/yyyy)
        HTML.getElementById("txtBirthDate").Value = Format(sht.Range("E" & i).Value, "dd/mm/yyyy")
        
        ' Click search and wait for results to load
        HTML.querySelector("button[onclick='SearchEmployee()']").Click
        Do While HTML.getElementById("TransactionInfo_WorkPermitNumber") Is Nothing
            DoEvents
        Loop
        
        ' Write scraped work permit number back to Excel (fixed direction!)
        sht.Range("G" & i).Value = HTML.getElementById("TransactionInfo_WorkPermitNumber").InnerText
    Next i
    
    ' Clean up IE resources
    IE.Quit
    Set IE = Nothing
    Set HTML = Nothing
    MsgBox "Scraping completed successfully!", vbInformation
End Sub

Fixed Get_Data Subroutine (XMLHTTP-Based, Faster) #

This version reads values from Excel rows instead of hardcoding, and uses a more reliable JSON parsing method. For production use, I recommend adding the VBA-JSON library for proper JSON handling, but this works with built-in functions for simplicity:

Sub Get_Data_Loop()
    Dim sht As Worksheet
    Dim LastRow As Long, i As Long
    Dim xmlHttp As Object
    Dim queryString As String
    Dim res As String
    Dim empID As String, workPermit As String
    
    Set sht = ThisWorkbook.Sheets("MOL")
    LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
    
    ' Initialize XMLHTTP (use 6.0 for better compatibility)
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    
    For i = 2 To LastRow
        ' Build JSON query from Excel values
        ' Note: MOL's API requires nationality codes (like "100" for Indian) instead of names
        ' Add a column in Excel for country codes to map names to their API values
        queryString = "{""PersonPassportNumber"":""" & sht.Range("C" & i).Value & """," & _
                      """PersonNationality"":""100""," & _ ' Replace with your code column (e.g., sht.Range("H" & i).Value)
                      """PersonBirthDate"":""" & Format(sht.Range("E" & i).Value, "dd/mm/yyyy") & """}"
        
        With xmlHttp
            .Open "POST", "https://eservices.mol.gov.ae/SmartTasheel/Dashboard/GetEmployees", False
            .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
            .SetRequestHeader "Content-Type", "application/json"
            .Send queryString
            
            res = .ResponseText
        End With
        
        ' Parse JSON response (more robust than nested Split)
        If InStr(res, """ID"":""") > 0 Then
            empID = Mid(res, InStr(res, """ID"":""") + 5)
            empID = Left(empID, InStr(empID, """") - 1)
        End If
        
        If InStr(res, """OtherData2"":""") > 0 Then
            workPermit = Mid(res, InStr(res, """OtherData2"":""") + 13)
            workPermit = Left(workPermit, InStr(workPermit, """") - 1)
        End If
        
        ' Write results to Excel
        sht.Range("F" & i).Value = empID
        sht.Range("G" & i).Value = workPermit
    Next i
    
    Set xmlHttp = Nothing
    MsgBox "API data retrieval completed!", vbInformation
End Sub

Key Improvements Explained #

1. Loop variable separation: Removed conflicting i usage in inner loops to keep row tracking intact.
2. Element waiting: Replaced fixed waits with loops that wait for specific elements to load—this makes the code reliable across different internet speeds.
3. IE optimization: Reused a single IE instance for all rows instead of spawning new windows.
4. Dropdown handling: Directly targeted the Nationality select element and its Options collection—the standard way to interact with dropdowns in VBA web scraping.
5. Data direction fix: Corrected the work permit value assignment to write scraped data to Excel, not the other way around.
6. Robust LastRow: Calculated the last row using column C (passport numbers) to avoid empty formatted rows affecting the count.
7. XMLHTTP enhancements: Added a proper user agent string, built dynamic queries from Excel rows, and improved JSON parsing logic.

Important Note for XMLHTTP Version #

MOL's API requires nationality codes (like "100" for Indian) instead of country names. You'll need to create a mapping table in Excel (e.g., column D = country name, column H = country code) and update the queryString to use sht.Range("H" & i).Value instead of the hardcoded "100".

内容的提问来源于stack exchange，提问作者Talal Z. Rana