September 23, 2015

How to follow multiple hyperlinks and extract webpage data

How to follow multiple hyperlinks and extract webpage data can be useful in a variety of situations. For example, a person may like to automate the process of extracting the sales price and then maximum retail price (mrp) of a product from an ecommerce website. Or, somebody may wish to login into a specific website and extract inventory data automatically. In our Excel training video today, we learn to follow many links on a website and navigate to a specific webpage from which we extract specific data for our database.


Watch this training video on YouTube.

Here’s the complete VBA macro code:

Sub testweb()

‘Below is a label

‘ First we create an Internet Explorer object, specify its location and size and ensure that the ‘webpage is completely loaded before we can perform automatic actions

Set objIE = CreateObject(“InternetExplorer.Application”)
objIE.Top = 0
objIE.Left = 0
objIE.Width = 1600
objIE.Height = 900
objIE.Visible = True ‘We can see IE

On Error Resume Next
objIE.navigate (“”)

If Err.Number <> 0 Then
Set objIE = Nothing
GoTo mystart:
End If
Loop Until objIE.readystate = 4

‘we define an object variable Alllinks and loop through all the links to search for

Set Alllinks = objIE.document.getElementsByTagName(“A”)
For Each Hyperlink In Alllinks
If InStr(Hyperlink.innerText, “Micromax Mobiles”) > 0 Then
Exit For
End If

‘we use a timer to wait for 2 seconds

Application.Wait (Now + TimeValue(“0:00:02”))

‘this code works as above

Set aAlllinks = objIE.document.getElementsByTagName(“A”)
For Each Hyperlink In aAlllinks
If InStr(Hyperlink.innerText, “With Dual SIM Facility”) > 0 Then
Exit For
End If

Application.Wait (Now + TimeValue(“0:00:02”))

Set bAlllinks = objIE.document.getElementsByTagName(“A”)
For Each Hyperlink In bAlllinks
If InStr(Hyperlink.innerText, “Micromax Unite 3 Q372 (Blue, 8GB)”) > 0 Then
Exit For
End If

Application.Wait (Now + TimeValue(“0:00:02”))

‘ now we locate a string and extract the number of characters we need

‘ we study the webpage thoroughly

Dim strCountBody As String
Dim startPos As Long
Dim startPos2 As Long
Dim endPos As Long
Dim endPos2 As Long
Dim textWanted As String
Dim textWanted2 As String
strCountBody = objIE.document.body.innerText
startPos = InStr(1, strCountBody, “Sale:”)
‘MsgBox startPos
endPos = startPos + 16
‘MsgBox endPos
textWanted = Mid(strCountBody, startPos, endPos – startPos)
textWanted = Right(textWanted, 8)

Application.Wait (Now + TimeValue(“0:00:02”))

startPos2 = InStr(1, strCountBody, “M.R.P.:”)
‘MsgBox startPos
endPos2 = startPos2 + 16
‘MsgBox endPos
textWanted2 = Mid(strCountBody, startPos2, endPos2 – startPos2)
textWanted2 = Right(textWanted2, 8)

‘we transfer the data to the worksheet

Range(“A2”) = objIE.document.Title
Range(“B2”) = textWanted
Range(“C2”) = textWanted2

Application.Wait (Now + TimeValue(“0:00:02”))

Set cAlllinks = objIE.document.getElementsByTagName(“A”)
For Each Hyperlink In cAlllinks
If InStr(Hyperlink.innerText, “See more product details”) > 0 Then
Exit For
End If

‘we quit the application Internet Explorer or close it

End Sub



5 thoughts on “How to follow multiple hyperlinks and extract webpage data

  1. Sub Bilanco()
    Dim I As Integer
    Dim myfile As String

    ‘ *** Dosyaisimlerini alıp listeliyor ***
    Pathname = “E:test”
    I = 1
    myfile = Dir(Pathname & “*.xls”)
    Cells(1, I) = myfile
    I = I + 1
    myfile = Dir
    Cells(I, 1) = myfile
    If myfile “” Then GoTo StartingPoint
    I = I – 1

    ‘ *** Dosyayı açıyor – Değeri ana dosyaya aktarıyor – Dosyayı tekrar kapıyor ***
    For K = 1 To I
    ‘On Error Resume Next

    ‘ *** Dosya Adı ***

    Filename = Cells(K, 1)
    Workbooks.Open (Pathname & Filename)

    ‘ *** Şirket Adı ***
    Cells(K, 2) = Workbooks(Filename).Worksheets(“Sheet1″).Cells(1, 1)

    ‘ *** Financial Depth***
    Cells(K, 3) = ” Financial Depth”
    For g = 1 To 220
    If Workbooks(Filename).Worksheets(“Sheet1″).Cells(g, 1) = ” Financial Depth” Then
    Cells(K, 4) = Workbooks(Filename).Worksheets(“Sheet1”).Cells(g, 2)
    Cells(K, 5) = Workbooks(Filename).Worksheets(“Sheet1″).Cells(g, 3)

    Exit For
    End If
    Next g

    there are 2 ” Financial Depth” with different value in workbook sheet1
    how i can get them two different cell

    thank you

  2. Respected sir
    I have changed the template of this given website according to my needs but i have 2 problems. One i can’t increase number of columns and second is i want to put searched data from data sheet to another new sheet and print. I watched many of ur videos. As i m new to excel its difficult for ms to fix it by myself. I shall b very thankful to u if u sort it for me in a video or just edit tbe file and email me.

    Best Regards
    Mirza Waqas Baig
    Dubai, United Arab Emirates

  3. Hello again,

    None of your templates for source code seem to work. Or rather, I am the one who cannot copy and paste without errors. Please advise as I think these are great video but cannot execute /run any templates provided.

    1. After copying and pasting check the code line by line. Some characters especially ‘quotes’ change.

  4. Dear sir
    Please send your contact details for excel mecro my contact number is 9598153950, 9565815555

Comments are closed.