Creating a VB Script that executes a search clicks a link and extracts a value

[Red88]

Hi everybody


I am very new to VB and try to get a solution together without any success. I went through a lot of forum posts but nothing I found was really addressing this issue

I have a list of 3000 companies for which all I have to lookup the Turnover value on a trade register website.

My idea was generating the search query which is pretty straight forward, so an example outcome would be
Yrityshaku | Kauppalehti.fi

Then comes the problematic part where i would have to extract the first hyperlink of the search result which in this case would be ABB Oy | Osakeyhtiö | Kauppalehti.fi (as you can see they add some id number at the end which is the reason why i cant directly point to this location in the start.

And then finally extract the Euro value from the field "Liikevaihto"

I tried to play around with query tables but they don't seem to be able to get any of the data where I find the link inside. Also I tried to use the really slow method through internet explorer where I used getElementsByTagName (but didnt manage to actually read out the link location, only the inner text of the tag itself).


I would be very thankful for every kind of advice, guidance or hint of how to approach this.


Best regards,
Red

 

[Red88]

I made some progress but I'm always getting an Error 91 as soon it reaches the line Set elementONE.
And sorry for the really bad and ugly coding. Also it seems to be surprisingly slow, is that due to the bad way i written this code?

Sub GetTurnover()


    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True


    'Contains extracted Direct Link from KL
    Dim directLink As String
    'Contains extracted Company Name from KL
    Dim regName As String
    'Contains extracted Turnover Value
    Dim turnoverValue As String
    Dim Search As String, Link As String
    Dim lastrow As Long
    Dim nextRow As Integer, iCount As Integer
    
    
For iCount = 1 To 1 'Application.CountA(Range("A:A"))
    Application.StatusBar = "Processing Page " & iCount
    nextRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
    
    Search = ActiveSheet.Cells(iCount, "A").value
    Link = "http://www.kauppalehti.fi/5/i/yritykset/yrityshaku/hakutulos.jsp?query=" & Search & "&submit.x=0&submit.y=0&submit=Hae&amount=3&from=0"


    Set ie = New InternetExplorer
      With ie
          .Navigate Link
          .Visible = False
          While .Busy Or .ReadyState <> READYSTATE_COMPLETE
             DoEvents
          Wend
          Set objHTML = .Document
          DoEvents
      End With
    
    'Extracting the direct Link
    Dim elementTwo
    Dim elementThree
    Dim elementFour
    Set elementONE = objHTML.getElementsByTagName("a")
    For i = 1 To elementONE.Length
        elementTwo = elementONE.Item(i).innerText
        If elementTwo Like "*" & "Ramboll" & "*" Then
            regName = elementONE.Item(i).innerText
            directLink = elementONE.Item(i).getAttribute("href")
           Debug.Print (elementTwo)
           Debug.Print (elementONE.Item(i).getAttribute("href"))
           
                    'Now Extract the Turnover Value
                    With ie
                        .Navigate directLink
                        .Visible = False
                        While .Busy Or .ReadyState <> READYSTATE_COMPLETE
                           DoEvents
                        Wend
                        Set objHTML = .Document
                        DoEvents
                    End With
                    
                    Set elementThree = objHTML.getElementsByTagName("td")


                    For i2 = 1 To elementThree.Length
                        elementFour = elementThree.Item(i2).innerText
                        If elementFour Like "Liikevaihto" & "*" Then
                            turnoverValue = elementThree.Item(i2 + 1).innerText
                            'remove non numeric characters
                                Dim i3 As Integer
                                Dim Original As String
                                Dim NumOnly As String
                                
                                Original = turnoverValue
                                NumOnly = ""
                                For i3 = 1 To Len(Original)
                                    If IsNumeric(Mid(Original, i3, 1)) Then
                                        NumOnly = NumOnly & Mid(Original, i3, 1)
                                    End If
                                Next 'i3
                                turnoverValue = NumOnly
                            Debug.Print (turnoverValue)
                            Exit For
                        End If
                    Next i2
            Exit For
        End If
    Next i
    DoEvents
    ie.Quit
    DoEvents
    Set ie = Nothing
    
'ThisWorkbook.Save
Next iCount
Application.StatusBar = False
End Sub