Extract phone numbers from a list of url

claudia80

Banned - Rules violations
Joined
Sep 2, 2017
Messages
14
I'm trying to extrapolate the phone number present in each url listed in sheet 1 column "A" of excel.
Unfortunately, I don't have the right knowledge to do it.
I insert some of the code that could be used.


VBA Code:
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim x As Variant
Dim i, j, k, l As Integer
Dim r As Long, LR As Long
Dim wsSheet As Worksheet, links As Variant, ie As Object, link As Variant
Dim rw As Long

    i = 2
    k = 2
    l = 1
    'SCEET2 as sheet with URL
    Set wb = ThisWorkbook
    Set wsSheet = wb.Sheets("Sheet1")
    
    'Set IE = InternetExplorer
    Set ie = CreateObject("InternetExplorer.Application")
    
    rw = wsSheet.Cells(wsSheet.Rows.Count, "A").End(xlUp).Row
    links = wsSheet.Range("A2:A" & rw)
    
    'IE Open Time per page 5sec and check links on Sheet2 Column A
    With ie
       .Visible = True
       Application.Wait (Now + TimeValue("00:00:0"))
       
       For Each link In links
           .navigate (link)
           While .Busy Or .readyState <> 4: DoEvents: Wend

Dim doc As HTMLDocument
Set doc = ie.document
Dim dd As Variant
On Error Resume Next

'variable for document or data which need to be extracted out of webpage

 '+++++++++ Extract Data from URL++++++++
                ''Extract elements
                 'If doc.getElementsByClassName("_50f4")(2) Is Nothing Then
                       ' wsSheet.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = "-"     
                ' Else
                   ' dd = doc.getElementsByClassName("_50f4")(2).innerText
                   ' Sheet1.Cells(Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row + 1, "B").Value = dd      
                 'End If
    
[B]'++++++++++++++++ I need Phone number code here +++++++++++++++++++++++++++[/B]
    
 [B]'++++++++++++++++ End Number search Code +++++++++++++++++++++++++++++++[/B]
 
On Error Resume Next

'Deletes duplicates in column A Sheet1
'Columns(2).RemoveDuplicates Columns:=Array(1)
' Columns(3).RemoveDuplicates Columns:=Array(1)

'navigate links
      Next link
'Close IE Browser
    .Quit
    End With
    
    Set ie = Nothing 
End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Dan_W

Active Member
Joined
Jul 11, 2018
Messages
409
Office Version
  1. 365
Platform
  1. Windows
I'm sorry - I'm confused. The code you have there loads up a web browser that not only navigates to a series of websites whose URLs are listed in column A, but before it progress through to the next one of those on the list, it navigates to any website linked to each of those websites. So this is a webcrawler?

Where are the actual phone numbers? To have any sample data?
 

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,054
Office Version
  1. 2016
Platform
  1. Windows
Dan_W and anyone else that can help.

By the sounds of this the Claudia80 is looking to build a site crawler that will navigate to urls and extract the phone numbers from a website. I have had a bit of dealing with Claudia80. I have advised that if it is one site e.g Yellow-Pages then the above code should do it, the Class will need to be changed in the commented out bit of the code.

So if Claudia80 had a list of ONLY Yellow-Page urls, then they could be placed in to column A and within the code the class changed to extract the phone numbers and it should work. As the structure of the site is the same and all classes should be the same, as the site is the same ONLY the urls are to different pages within that same site.

However my understand is that, Claudia80 has a LIST of domains/urls and each site is unique. Therefore as I have advised the structure of each site will be different and therefore you will have different classes so one code will not fit all, unless someone knows how to do that. When it comes to extracting emails, most websites will either use the following two tags @ or mailto: Therefore this can be placed in the vba code to look for these two reffs and emails can be extracted from multiple site, with one code.

I think what Claudia80 is after is how to extract phone numbers from multiple urls in column A, with one code.

Currently The above code will loop through urls, the bit that is missing, is a CODE that will look for phone numbers AND PLACE IN COLUMN B. Its' not like you can put in a CLASS of "Phone" and it will extract phone numbers from websites. As stated above you can use mailto: or @ sign for emails and normally one code will fit all.

Q) Is there a one code to fit all for phone numbers, I think that is what Claudia80 is after as,
 

claudia80

Banned - Rules violations
Joined
Sep 2, 2017
Messages
14
Hi.
Sharid understood the problem well.
There are several urls listed in column "a" and the macro requires extrapolating the phone number from each website and pasting it in the column corresponding to the url.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,301
Messages
5,635,408
Members
416,856
Latest member
silentir

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top