أخي الكريم مهند ..
تفضل الكود التالي (وهو كود يحتاج لتفعيل بعض المكتبات من خلال قائمة Tools ثم References) والمكتبات هي Microsoft HTML Object Library ومكتبة Microsoft XML, v6.0
الكود سيعمل على ورقة العمل النشطة لذا قم بتنشيط ورقة عمل فارغة تماماً ثم نفذ الكود (الكود ستنفذه لمرة واحدة وبعد ذلك تستخدم تلك البيانات في الفورم) ..
سيقوم الكود بجلب الدول وبجوار كل دولة الرقم المرتبط بها (هذا سيكون في الصف الأول) ، وتحت اسم كل دولة المدن التابعة لها وأرقام الـ ID المرتبطة بكل مدينة في هذه الدول
Sub Test()
Const sURL As String = "https://www.masrawy.com/Islameyat/Prayer-Times"
Dim v, html As MSHTML.HTMLDocument, ws As Worksheet, post As Object, sID As String, nURL As String, i As Long, c As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set html = GetHTML(sURL)
Set post = html.querySelectorAll("div .wrapperDropdown[tabindex='1'] li")
c = 1
With post
For i = 0 To .Length - 1
ws.Cells(1, c).Value = .Item(i).innerText
sID = .Item(i).getElementsByTagName("a")(0).getAttribute("countryid")
ws.Cells(1, c + 1).Value = sID
nURL = "https://www.masrawy.com/Islameyat/GetCityList?countryId=" & sID
v = GetCities(nURL)
ws.Cells(2, c).Resize(UBound(v, 1), UBound(v, 2)).Value = v
c = c + 2
Next i
End With
End Sub
Function GetCities(ByVal sURL As String)
Dim html As MSHTML.HTMLDocument, post As Object, i As Long
Set html = GetHTML(sURL)
Set post = html.querySelectorAll("#ulCityList li")
With post
ReDim a(1 To .Length, 1 To 2)
For i = 0 To .Length - 1
a(i + 1, 1) = .Item(i).innerText
a(i + 1, 2) = .Item(i).getElementsByTagName("a")(0).getAttribute("cityid")
Next i
End With
GetCities = a
End Function
Function GetHTML(ByVal sURL As String) As HTMLDocument
Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
Set http = New MSXML2.XMLHTTP60
Set html = New MSHTML.HTMLDocument
With http
.Open "Get", sURL, False
.send
html.body.innerHTML = .responseText
End With
Set GetHTML = html
End Function