[nikos1980]

Καλησπέρα σε όλους και καλώς σας βρήκα.

Είμαι καινούργιου στην VBA και χρειάζομαι τα φώτα σας.

Προσπαθώ να φτιάξω σε excel2010 έναν τρόπο ώστε να μου μαζεύει πληροφορίες από ένα ευρετήριο από ένα site.

Το site είναι το greekjustice

Μετά από πολύ ψάξιμο κατάφερα να το φτάσω σε ένα σημείο. Έχω καταφέρει να μου ανοίγει το site και να πηγαίνει στο κουτάκι ΠΕΡΙΟΧΗ και να βάζει αυτό που του έχω δηλώσει, σε κουτάκι μέσα στο excel. Το πρόβλημα τώρα είναι ότι δεν μου δουλεύει ο μετρητής, ώστε να φέρνει τα στοιχεία το ένα κάτω από το άλλο και δεν μπορώ να βρώ πως θα χωρήσω το τηλ,φαξ και διεύθυνση τα οποία είναι μέσα στην HTML,σε ένα body.

Ο κώδικας είναι

Sub test()

Dim eRow As Long
Dim ele As Object
Dim envFrmwrkPath As String
Dim ApplicationName As String
Dim TestIterationName As String

RowCount = 2
Set sht = Sheets("Sheet1")
sht.Range("A" & RowCount) = "Onoma"
sht.Range("B" & RowCount) = "diethinsi"
sht.Range("C" & RowCount) = "thl"
sht.Range("D" & RowCount) = "fax"
sht.Range("E" & RowCount) = "email"
sht.Range("F" & RowCount) = "TK"


eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Set objIE = CreateObject("InternetExplorer.Application")

myarea = InputBox("Περιοχή")

With objIE
.Visible = True
.navigate "*************/"

Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop

Set periorxi = .Document.getElementsByName("mod_search_area")
periorxi.Item(0).Value = myarea

.Document.forms(1).submit

Do While .Busy Or _
.ReadyState <> 4
DoEvents
Loop

For Each ele In .Document.all
Select Case ele.classname
Case "Result"
RowCount = RowCount + 1
Case "searchResultsTitle"
sht.Range("A" & RowCount) = ele.innertext
Case "articles_body"
sht.Range("D" & RowCount) = ele.innertext
Case "emailres"


End Select

Next ele
End With

'macro1

Set objIE = Nothing


End Sub

Ευχαριστώ πολύ

ΥΓ τα **** είναι το site, απλά γιατί δεν με αφήνει να το βάλω το έκανα έτσι