Parsanje stranki preko excel macroja

#1Pozdravljeni

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