Macro to query website search funtion

[mikeymay]

I have a list of 800ish unique establishment references and I need to enter each one into a search box on a website to get a specific item of information form the result.

I can see there are quite a few solutions out there but I need to get this done ASAP and as I need to work on other areas of the project I'm going to struggle to develop an existing piece of code so I was hoping someone could point me in the general right direction.

The website isAdvanced searchand I need to enter a URN reference after selecting 'To find out a specific establishment fill in its identifier' - 140764 is an example

From the result I need to get the Postcode (this needs to be selected form the option to 'show additional columns') and the URN and postcode to be added to a blank Excel file.


TIA

 

[brawnystaff]

Try the following:

Sub ListPostalCode()
'get Postal Code  from URN
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   On Error Resume Next
   Dim Cell As Range, rng As Range
   Dim URN As String
    Set rng = Selection
     For Each Cell In rng
     If Cell <> vbNullString And Cell.EntireRow.Hidden = False Then
          URN = Cell.Value
     Cell.Offset(0, 1) = getURN(URN)
     End If
     Next Cell
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub


Public Function getURN(Number As String)
    On Error GoTo errorhandler:
    
    'Function to get URN Postal Code from URN number
    Web_URL = "http://www.education.gov.uk/edubase/establishment/summary.xhtml?urn=" & Number
 
 
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", Web_URL, False
        .send
        resultstring = .responseText
    End With
    
    emptyresult = "*Establishment is not found*"
    
    If resultstring = emptyresult Then
        getURN = "URN not found"
        Exit Function
    End If
    
    searchstring = "postal-code"
    namestart = InStr(1, resultstring, searchstring) + 13
   Nameend = InStr(namestart, resultstring, "<") - namestart
    finalname = Mid(resultstring, namestart, Nameend)
    getURN = finalname
    Exit Function
errorhandler:
    getURN = "Error in Request"
End Function

Be sure to select the URNs you want the Postal Codes for in Excel