Below macro is given by Brian and it checks a URL and find if it shows results Yes/No
Can i get all the URL's that are shown below
Example
http://alturl.com/mseg7
this link shows 9 results. Can i get the Number 9 in a column and then the 9 URL's so i can check them directly (Any format is fine)
Option Explicit
Sub Check_URLS()
Dim i As Long
Dim xResult As String
Dim xCell As Range
Dim xLast_Row As Long
Sheets("Check URL's").Activate
xLast_Row = Range("A1").SpecialCells(x
lLastCell)
.Row
If xLast_Row < 2 Then
MsgBox ("No data found - run cancelled.")
Exit Sub
End If
Range("B2:B" & xLast_Row).ClearContents
For Each xCell In Range("A2:A" & xLast_Row)
If xCell <> "" Then
i = i + 1
xResult = Get_URL(xCell.Value)
Else
xResult = "N/A"
End If
xCell.Offset(0, 1) = xResult
Application.ScreenUpdating
= True
Next
End Sub
Function Get_URL(xUrl As String)
Dim xTempSheet As Worksheet
Dim xConnection As String
Dim xFound As Range
Application.ScreenUpdating
= False
Set xTempSheet = Sheets.Add
xConnection = "x" & Format(Now(), "hhmmss")
On Error Resume Next
With xTempSheet.QueryTables.Add
(Connectio
n:="URL;" & xUrl, Destination:=Range("$A$1")
)
.Name = xConnection
.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
.WebPreFormattedTextToColu
mns = True
.WebConsecutiveDelimitersA
sOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition
= False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
On Error GoTo 0
Dim fred
Set fred = xTempSheet.QueryTables(1)
If xTempSheet.Range("A1").Spe
cialCells(
xlLastCell
).Row = 1 Then
Application.DisplayAlerts = False
xTempSheet.Delete
Application.DisplayAlerts = True
Get_URL = "N/A"
Exit Function
End If
Set xFound = xTempSheet.Range("A:A").Fi
nd(What:="
Your search yielded no results", LookIn:=xlFormulas, LookAt:=xlPart _
, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If xFound Is Nothing Then
Get_URL = "False"
Else
Get_URL = "True"
End If
Application.DisplayAlerts = False
xTempSheet.Delete
Application.DisplayAlerts = True
End Function
Plerase see attached. If a page isn't found then a value of -1 is shown. The code is...
Open in new window
Regards,Brian.