Parsanje stranki preko excel macroja

1 naročnik

Pozdravljeni

Prijatelj me je včeraj spraševal, kako bi nafilu dejavnost za podjetja, ki jih ima shranjena v excelu. Ko sem mu razložil, da se to lahko anrdi z makroji in da pač zahteva neko znanje - ni samo neko klikanje next next next - se je odločil da počaka. Osebno mi pa ni dalo miru in namesto da bi petkov večer preživel bolj ustrezno, sem na hitro sprogramiral makro ki

1. gre na stran
2. malo klika
3. prebere podatke
4. shrani v excel

Ne iščem pomoči, ampak samo delim kodo z ostalimi, če bo mogoče kdaj kdo kaj pdoobnega počel in bo rabil pomoč.. zaradi varnosti sem odstranil stran katero parsam

Makro bere vrstico v excelu, potem odpre IE, gre na stran, vpiše ime podjetja v search input ter klikne search. Ko dobi rezultate, klikne na prvi rezultat, gre na predstavitveno stran ter prebero vrednost iz nekega elementa... vmes sem dodal tudi da me zahtevami čaka, da ne bom banan...

Sub IskanjeDejavnosti()
    Dim i As Long, Name As String, FoundCompany As Boolean
    FoundCompany = False
    Set Target = Selection

    Dim ie As InternetExplorer
    Set ie = New InternetExplorer

    Cells(1, 9).Value = "delam ..."

    For i = 2 To Target.Rows.Count

        If IsEmpty(Cells(i, 8).Value) Then

            Name = Cells(i, 4).Value

            Cells(1, 9).Value = Name

            With ie
              .Visible = True
              .navigate "http://www.example.com"

              Do While .Busy: DoEvents: Loop
              Do While .ReadyState <> 4: DoEvents: Loop

              Application.Wait Now + TimeSerial(0, 0, 2)

              .document.getElementById("ctl00_ContentPlaceHolderLeft_ucSearchCommon_tbSearchWhat").Value = Name
              .document.getElementById("ctl00_ContentPlaceHolderLeft_ucSearchCommon_btnSearch").Click

              Do While .Busy: DoEvents: Loop
              Do While .ReadyState <> 4: DoEvents: Loop

              Application.Wait Now + TimeSerial(0, 0, 2)

              For Each link In .document.Links
                If StringEndsWith(link.ID, "_linkCompany") Then
                    FoundCompany = True
                    link.Click

                    Exit For
                End If
              Next link

              Do While .Busy: DoEvents: Loop
              Do While .ReadyState <> 4: DoEvents: Loop

              Application.Wait Now + TimeSerial(0, 0, 2)

              If FoundCompany Then
                Cells(i, 8).Value = .document.getElementById("ctl00_ctl00_ContentPlaceHolderLeft_ContentMain_CompanyDetailsCommon1_CompanySPLPreview1_labMainActivity").innerHTML
                Cells(i, 9).Value = "opravil"
              Else
                Cells(i, 9).Value = "ne najdem podjetja"
              End If
            End With

            FoundCompany = False
            Application.Wait Now + TimeSerial(0, 0, 5)
        End If
    Next i

    Set ie = Nothing
    Cells(1, 9).Value = "koncal"

End Sub

Public Function StringEndsWith(ByVal strValue As String, _
   CheckFor As String, Optional CompareType As VbCompareMethod _
   = vbBinaryCompare) As Boolean
 'Determines if a string ends with the same characters as
 'CheckFor string

 'True if end with CheckFor, false otherwise

 'Case sensitive by default.  If you want non-case sensitive, set
 'last parameter to vbTextCompare

  'Examples
  'MsgBox StringEndsWith("Test", "ST") 'False
  'MsgBox StringEndsWith("Test", "ST", vbTextCompare) 'True

  Dim sCompare As String
  Dim lLen As Long

  lLen = Len(CheckFor)
  If lLen > Len(strValue) Then Exit Function
  sCompare = Right(strValue, lLen)
  StringEndsWith = StrComp(sCompare, CheckFor, CompareType) = 0

End Function