Hello all. I have been trying to run a macro using a Web Query to retrieve contact details from a number of websites (libraries). I have the websites listed in a column and use that range within my code.
I am particularly looking to retrieve the phone number and email from the websites. The details can sometimes be found on the home page (to which I am directed using the website addresses in my range), but sometimes I need to click on a Contact section within the website.
I am new to Web Queries and haven't quite been able to get my head round it. I've searched numerous message boards and used Excel's help, but either couldn't find the perfect solution or couldn't understand it!
Is it possible to write some code to search within the website for the details I need? Perhaps looking for the word "email" for example". I have included some code which I have used so far. This copies the entire home page and searches for the information after it has been imported into Excel. Unfortunately, this only works when the information is set out in the same way. When the format of the web page changes, no luck.
(Some aspects of the code are specific to a certain webpage. That's why it doesn't really work).
Sub Retrieve()
Application.ScreenUpdating = False
Area = "South East"
Set Libraries = Sheets(Area).Range("N14:N27")
For Each Library In Libraries
a = Library.Text
b = Mid(a, 61, Len(a) - 60)
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & a, Destination:=Range("$A$1"))
.Name = b
.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
Dim Target As Range, x As Integer, y As Integer, z As Integer, Phone As String, Email As String, NextRow As Integer, j As Integer, PostCode As String
Set Target = ActiveSheet.Range("A30:A300")
NextRow = WorksheetFunction.CountA(Sheets(Area).Range("K:K")) + 4
For Each Cell In Target
If Cell.Text = "Contact" Then
x = Cell.Row
Exit For
End If
Next Cell
For Each Cell In Target
If Left(Cell.Text, 3) = "Tel" Then
y = Cell.Row
j = Cell.Row - 2
PostCode = Cells(j, 1).Text
Phone = Cells(y, 1).Text
Sheets(Area).Cells(NextRow, 11) = Mid(Phone, 27, Len(Phone) - 26)
Sheets(Area).Cells(NextRow, 10) = PostCode
Exit For
End If
Next Cell
For Each Cell In Target
If Left(Cell.Text, 5) = "Email" Then
z = Cell.Row
Email = Cells(z, 1).Text
End If
Sheets(Area).Cells(NextRow, 4) = Mid(Email, 8, Len(Email) - 7)
Exit For
Next Cell
Range(Cells(x + 2, 1), Cells(y - 3, 1)).Copy Range("L5")
Range("L5:L9").Select
Selection.Copy
Sheets("South East").Activate
Cells(NextRow, 5).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Next Library
End Sub
I realise that the code is probably not exactly elegant, and apologies if I seem to be rambling. I'm not sure how to simplify my question. In a nutshell, though, here's what I need to do:
Find a way for Excel to recognise where the data I need is within the website
or
If I just need to import the entire page, I could do with a better way to search for the information I need.
I've seen words like "Dynamic Web Queries" and "parameters" thrown around. I suspect a possible answer to my woes lies here, but I need someone to hold my hand!
Alternatively, if anybody realises that what I'm trying to do is impossible, letting me know would probably save me a lot of heartache.
(I may not have provided enough information here, but I can hopefully elaborate if anybody is willing to help me out. Thanks in advance).
I am particularly looking to retrieve the phone number and email from the websites. The details can sometimes be found on the home page (to which I am directed using the website addresses in my range), but sometimes I need to click on a Contact section within the website.
I am new to Web Queries and haven't quite been able to get my head round it. I've searched numerous message boards and used Excel's help, but either couldn't find the perfect solution or couldn't understand it!
Is it possible to write some code to search within the website for the details I need? Perhaps looking for the word "email" for example". I have included some code which I have used so far. This copies the entire home page and searches for the information after it has been imported into Excel. Unfortunately, this only works when the information is set out in the same way. When the format of the web page changes, no luck.
(Some aspects of the code are specific to a certain webpage. That's why it doesn't really work).
Sub Retrieve()
Application.ScreenUpdating = False
Area = "South East"
Set Libraries = Sheets(Area).Range("N14:N27")
For Each Library In Libraries
a = Library.Text
b = Mid(a, 61, Len(a) - 60)
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & a, Destination:=Range("$A$1"))
.Name = b
.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
Dim Target As Range, x As Integer, y As Integer, z As Integer, Phone As String, Email As String, NextRow As Integer, j As Integer, PostCode As String
Set Target = ActiveSheet.Range("A30:A300")
NextRow = WorksheetFunction.CountA(Sheets(Area).Range("K:K")) + 4
For Each Cell In Target
If Cell.Text = "Contact" Then
x = Cell.Row
Exit For
End If
Next Cell
For Each Cell In Target
If Left(Cell.Text, 3) = "Tel" Then
y = Cell.Row
j = Cell.Row - 2
PostCode = Cells(j, 1).Text
Phone = Cells(y, 1).Text
Sheets(Area).Cells(NextRow, 11) = Mid(Phone, 27, Len(Phone) - 26)
Sheets(Area).Cells(NextRow, 10) = PostCode
Exit For
End If
Next Cell
For Each Cell In Target
If Left(Cell.Text, 5) = "Email" Then
z = Cell.Row
Email = Cells(z, 1).Text
End If
Sheets(Area).Cells(NextRow, 4) = Mid(Email, 8, Len(Email) - 7)
Exit For
Next Cell
Range(Cells(x + 2, 1), Cells(y - 3, 1)).Copy Range("L5")
Range("L5:L9").Select
Selection.Copy
Sheets("South East").Activate
Cells(NextRow, 5).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Next Library
End Sub
I realise that the code is probably not exactly elegant, and apologies if I seem to be rambling. I'm not sure how to simplify my question. In a nutshell, though, here's what I need to do:
Find a way for Excel to recognise where the data I need is within the website
or
If I just need to import the entire page, I could do with a better way to search for the information I need.
I've seen words like "Dynamic Web Queries" and "parameters" thrown around. I suspect a possible answer to my woes lies here, but I need someone to hold my hand!
Alternatively, if anybody realises that what I'm trying to do is impossible, letting me know would probably save me a lot of heartache.
(I may not have provided enough information here, but I can hopefully elaborate if anybody is willing to help me out. Thanks in advance).