• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Code to extract links to all Cities of countries of the world from a specific site

If I got what you mean, here's a code that will grab all the links to all the countries.. Create a new blank sheet and run the code
Code:
Sub GetLinks()
    Dim html As MSHTML.HTMLDocument, ws As Worksheet, post As Object, sURL As String, x As Integer, i As Long, r As Long

    For x = 65 To 90
        sURL = "https://www.prayer-times.info/en/filter-" & Chr(x) & "/"
        Set ws = ThisWorkbook.Worksheets("Sheet1")
        Set html = GetHTML(sURL)
        Set post = html.querySelectorAll("#country_list li")
       
        With post
            If .Length > 0 Then
                For i = 0 To .Length - 1
                    r = r + 1
                    ws.Cells(r, 1).Value = Trim(Replace(.Item(i).innerText, vbCrLf, ""))
                    ws.Cells(r, 2).Value = .Item(i).getElementsByTagName("a")(0).getAttribute("href")
                Next i
            End If
        End With
    Next x
End Sub

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
 
Last edited:
So you need to get all the cities for just one country or for all the countries ..? You have to be specific
 
You have to be specific about the expected results. Will you make each country in a sheet or A group country in a sheet- B group country in a sheet ? or all in one sheet ? And if all are in one sheet how would you like the results to be exactly?
 
Try this code
Code:
Sub Get_Links_Prayer_Times()
    Dim v, html As MSHTML.HTMLDocument, ws As Worksheet, post As Object, sURL As String, nURL As String, x As Integer, i As Long, r As Long, c As Long
   
    Application.DisplayAlerts = False
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> "Sheet1" Then ws.Delete
        Next ws
    Application.DisplayAlerts = True
       
    For x = 65 To 66
        sURL = "https://www.prayer-times.info/en/filter-" & Chr(x) & "/"
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = Chr(x)
        Set html = GetHTML(sURL)
        Set post = html.querySelectorAll("#country_list li")
        c = 1
   
        With post
            If .Length > 0 Then
                For i = 0 To .Length - 1
                    r = r + 1
                    ws.Cells(1, c).Value = Trim(Replace(.Item(i).innerText, vbCrLf, ""))
                    ws.Cells(1, c + 1).Value = .Item(i).getElementsByTagName("a")(0).getAttribute("href")
                    v = GetCities(CStr(ws.Cells(1, c + 1).Value))
                    ws.Cells(2, c).Resize(UBound(v, 1), UBound(v, 2)).Value = v
                    c = c + 2
                Next i
            End If
        End With
           
        ws.Columns.AutoFit
    Next x
   
    MsgBox "Done...", 64, "YasserKhalil Chandoo"
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("#city_list li")
    With post
        ReDim a(1 To .Length, 1 To 2)
        For i = 0 To .Length - 1
            a(i + 1, 1) = Split(.Item(i).innerText)(UBound(Split(.Item(i).innerText)))
            a(i + 1, 2) = .Item(i).getElementsByTagName("a")(0).getAttribute("href")
        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

This will create a sheet for each group : A-group countries / B-group countries and so on
And in each sheet, the country and the link related will be in row 1 while the cities following each country will be listed below the related country
Hope this will solve the problem at all

** The code will grab only A group and B group.. You can change the number 66 to 90 to get the whole countries but this would take too much time.
 
it's very good Code ,but for Example it extract site as
https://www.prayer-times.info/en/bangladesh/chittagong/
but i want to be like
http://www.prayer-times.info/show_prayertimes.php?city_link=chittagong&box_style=1
because i have my code to get Prayer times by this forme of Site
Code:
Sub XlsMilev()
Application.ScreenUpdating = False
On Error Resume Next
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Sheets("Tmp").Visible = True
Sheets("Parametre").Visible = True
Sheets("M-salat").Select
Range("P9").Select
Dim nabil1 As String
Dim nabil2 As String
Sheets("M-Salat").Select
nabil1 = Range("P12")
nabil2 = Range("P12")
    Sheets("Tmp").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
   With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & nabil1, Destination:=Range("A1"))
                .Name = "show_prayertimes.php?city_link=constantine&box_style=2_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
 
    Range("A1").Select
    Columns("A:A").ColumnWidth = 28.43
    Range("A1:A20").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
        Range("A1").Select
    Dim nabil10 As String
Dim nabil11 As String
Dim nabil12 As String
Dim nabil13 As String
Dim nabil14 As String
Dim nabil15 As String
Dim nabil16 As String
Dim nabil17 As String
Dim nabil18 As String
Dim nabil19 As String
Dim nabil20 As String

Sheets("Tmp").Select
nabil10 = Range("A2")
nabil11 = Range("A3")
nabil12 = Range("A4")
nabil13 = Range("A6")
nabil14 = Range("A7")
nabil15 = Range("A9")
nabil16 = Range("A11")
nabil17 = Range("A13")
nabil18 = Range("A15")
nabil19 = Range("A17")
nabil20 = Range("A19")

Sheets("M-salat").Select
Range("AC20") = nabil10
Range("AC21") = nabil11
Range("U14") = nabil12
Range("M17") = nabil13
Range("L20") = nabil14
Range("AK26") = nabil15
Range("AF26") = nabil16
Range("AA26") = nabil17
Range("V26") = nabil18
Range("Q26") = nabil19
Range("L26") = nabil20

Sheets("Tmp").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Parametre").Select
ActiveWindow.SelectedSheets.Visible = False
        
Sheets("M-salat").Select
Range("P9").Select
        
End Sub
 
Last edited:
Try such a code .. I am lost in this topic (no clear logic)
Code:
Sub TestMe()
    Dim s As String, sCity As String
    s = "https://www.prayer-times.info/en/bangladesh/chittagong/"
    sCity = Split(s, "/")(UBound(Split(s, "/")) - 1)
    
    Debug.Print "http://www.prayer-times.info/show_prayertimes.php?city_link=" & sCity & "&box_style=1"
End Sub
I have to let others share in the topic. I am out.
 
What code exactly that doesn't work? >> I have tested the code on all the countries and cities and work for all of them with no problem at all
Is there any errors while running the code?
Have you checked the references that are related to the code?

Please be specific when describing a problem.
 
last one
Sub TestMe()
as you see in Photo ,what i want
 

Attachments

  • 1.png
    1.png
    60.3 KB · Views: 12
  • 2.png
    2.png
    39.9 KB · Views: 12
Last edited:
vletm
yes of course Actually, I read this post carefully , but as I want i didn't need this Result from the Code i want anothe Sites
I just need the Results as i Upload before in #15
thanks alot for your Replay
 
Hany ali
One more time.
Okay - You read - that's good start.
But
You have NOT given answers to those questions!
What code exactly that doesn't work?
Is there any errors while running the code?
Have you checked the references that are related to the code?

as well as
Please be specific when describing a problem.
It won't help anybody - if You can only write 'need'.
You should able to find out more words that You could get something.
 

Attachments

  • 1.png
    1.png
    53.4 KB · Views: 4
  • 2.png
    2.png
    23.5 KB · Views: 5
Last edited:
Instead of losing hope, it is better to post a new thread with a clear attachment and clear explanation. That's my opinion.
 
Back
Top