Reputation: 15
I'm a beginner in VBA and I'm facing problem in selecting country name automatically in web Combo box using cell value from my Excel sheet via loop. It'll be great help if someone could just help me to fix my VBA and XMLHTTP code. My sheet and VBA code is as follows,
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
Upvotes: 1
Views: 358
Reputation: 84465
Comments:
Here is an example with selenium basic which should be easy to adapt to a loop or even to re-write for Internet Explorer.
You can play around with adding explicit wait times if you choose ( thanks to @Topto for reminding me of those). Examples shown below. The one case where explicit wait, selenium style, didn't seem to work is with Passport #. Here I added a loop to ensure that it was displayed before attempting to update.
References:
The selenium basic wrapper is free. After installation you go VBE > Tools > References > Selenium type library
TODO:
This was to demonstrate the principals. You can easily start the driver and then have your loop pick up variables from the sheet and issue new GET requests.
Code:
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
No selenium based answer (based on @SIM's answer you referenced)
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
Upvotes: 2