VBA - Ignore URL webscrape if link doesn't work

[jamescooper]

Hello I have the following code that pulls the data from the URLs listed in cells A1:A84. How would I modify it please so that it ignores urls that do not have any content?

Many thanks.

Sub Data()
 Dim URL As Range
 Dim nxRw As Long
 Dim Addrw As Long
 Sheets("Data").Select
 For Each URL In Range("A1:A84")
 nxRw = Range("C" & Rows.Count).End(xlUp).Row + Addrw * 2
 With ActiveSheet.QueryTables.Add(Connection:="URL;" & URL.Value & "", _
     Destination:=Range("C" & nxRw))
     .Name = Right(URL.Value, 27)
     .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
Addrw = 1
Next URL


End Sub

 

[Ombir]

You have to share some url and explain in detail which url you want to ignore and what you're really want to fetch from remaining urls ?

 

[jamescooper]

Hello,

If the URL is false, i.e. a page does not exist, ignore these in the range, which in the above example is A1:A84.

Does that help?

 

[jamescooper]

Any ideas please thanks.

 

[Ombir]

Try this:

Function Isurlvalid(ByVal url As String) As Boolean
Dim myreq As Object

    Isurlvalid = False
    Set myreq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    If Not url Like "http*" Then
        url = "http://" & url
    End If
    
    On Error GoTo Notvalid
    
    With myreq
        .Open "GET", url, False
        .send
        If .Status = 200 Then Isurlvalid = True
        Exit Function
    End With
Notvalid:
End Function

 

[jamescooper]

Try this:

Function Isurlvalid(ByVal url As String) As Boolean
Dim myreq As Object

    Isurlvalid = False
    Set myreq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    If Not url Like "http*" Then
        url = "http://" & url
    End If
    
    On Error GoTo Notvalid
    
    With myreq
        .Open "GET", url, False
        .send
        If .Status = 200 Then Isurlvalid = True
        Exit Function
    End With
Notvalid:
End Function

Sorry, how do I refer to the range where my URLs are located in column A please?

Also, it doesn't appear to run, as no Sub at the start?

Thanks.

 

[Ombir]

Sorry, how do I refer to the range where my URLs are located in column A please?

Also, it doesn't appear to run, as no Sub at the start?

Thanks.

This is a User Defined Function. You can call it passing each url as parameter and check if it returns True or False.

Sub james()
Dim rng As Range
Dim cell As Range

Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

For Each cell In rng
    If Isurlvalid(cell.Value) Then
        'Place your other code here
        'Place your other code here
        'Place your other code here
        'Place your other code here
    End If
Next
End Sub
Function Isurlvalid(ByVal url As String) As Boolean
Dim myreq As Object

    Isurlvalid = False
    Set myreq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    If Not url Like "http*" Then
        url = "http://" & url
    End If
    
    On Error GoTo Notvalid
    
    With myreq
        .Open "GET", url, False
        .send
        If .Status = 200 Then Isurlvalid = True
        Exit Function
    End With
Notvalid:
End Function