Moderatori: Anthony47, Flash30005
Anthony47 ha scritto:Non posso fare un trattato di excel, dammi un url su cui lavorare e posso provare a spiegare.
La documentazione delle libreria mshtml.tlb la trovi qui: http://msdn.microsoft.com/en-us/library ... 85%29.aspx, voce MSHTML Reference (MSDN Library- Web Development- Internet Explorer Development- Hosting and Reuse)
Purtroppo e' un po' piu' criptica rispetto a quella che troviamo nell' help on line.
Ciao
Sub ppazzi()
myURL = "http://www.prezzipazzi.com/"
Set IE = CreateObject("InternetExplorer.Application")
Sheets("Foglio3").Select
Range("A:C").Clear
With IE
.navigate myURL
.Visible = True
Do While .Busy: DoEvents: Loop 'Attesa not busy
Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
End With
myStart = Timer
Do
DoEvents
If Timer > myStart + 3 Or Timer < myStart Then Exit Do
Loop
'cerca ed elenca Id e Descrizioni
Set myColl = IE.document.getElementsByTagName("a")
For Each myLink In myColl
LTit = myLink.Title
LLin = myLink.href
If LTit <> "" And Len(LLin) = 17 + Len(Replace(Replace(LLin, "/prodotto/", ""), ".php?id", "")) Then
Cells(I + 1, 1) = Mid(LLin, InStr(1, LLin, ".php?id", vbTextCompare) + Len(".php?id"), 99)
Cells(I + 1, 2) = LTit
' Cells(I + 1, 3) = LLin
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I + 1, 3), Address:=LLin, _
TextToDisplay:=LLin
I = I + 1
End If
Next myLink
'aaa = IE.document.body.outerHTML
'Cells(1, 6) = aaa
Stop '<<< Vedi testo
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub
LTit e' il "Titolo" del link; LLnk e' il link vero e proprio; l' istruzione successiva controlla che il link contenga "/prodotto/" e ".php?id", se Si allora vengono elencati Id (contenuto in LLnk) , Descrizione (LTit), e il link (LLnk).Mi spiegheresti che tipo di ricerca hai fatto con quel If LTit <>" and ecc. 17+ Len (replace ecc. ecc.)
'cerca ed elenca Id e Descrizioni
Set myColl = IE.document.getElementsByTagName("a")
For Each myLink In myColl
LTit = myLink.Title
LLin = myLink.href
If LTit <> "ZZ" And Len(LLin) = 12 + Len(Replace(LLin, "/bin/detail/", "")) Then
If Oldescr <> Mid(LLin, InStrRev(LLin, "/") + 1, 999) Then
Oldescr = Mid(LLin, InStrRev(LLin, "/") + 1, 999)
Cells(I + 1, 1) = Mid(LLin, InStr(1, LLin, "/bin/detail/", vbTextCompare) + Len("/bin/detail/"), 6)
Cells(I + 1, 2) = Mid(LLin, InStrRev(LLin, "/") + 1, 999)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I + 1, 3), Address:=LLin, _
TextToDisplay:=LLin
I = I + 1
End If
End If
Next myLink
'aaa = IE.document.body.outerHTML
'Cells(1, 6) = aaa
Stop '<<< Vedi testo
myURL = "http://www.bidfun.com/?force_cc=1" '<<Sito Usa
myURL = "http://www.bidfun-it.com/" '<< Sito Italia
myURL = "http://www.bidfun.com/" '<< Sito da scegliere
Sub ppazzi()
myURL = "http://www.prezzipazzi.com/" 'L' indirizzo di navigazione
'adesso si crea un processo InternetExplorer
Set Ie = CreateObject("InternetExplorer.Application")
'Si pulisce l' area che sara' usata per i risultati
Sheets("Foglio3").Select
Range("A:C").Clear
With Ie
.navigate myURL 'si attiva la navigazione all' url indicato prima
.Visible = True 'si rende visibile I.Explorer
Do While .Busy: DoEvents: Loop 'Attesa not busy (di IE)
Do While .ReadyState <> 4: DoEvents: Loop 'Attesa documento scaricato in IE
End With
'Aspetto 3 secondi perche' non mi fido di ReadyState=4
myStart = Timer
Do
DoEvents
If Timer > myStart + 3 Or Timer < myStart Then Exit Do
Loop
'cerca ed elenca Id e Descrizioni
Set myColl = Ie.Document.getElementsByTagName("a") 'Crea una "collezione" dei tag="a"
For Each myLink In myColl 'si controlla ogni elemento della collezione
LTit = myLink.Title '"Titolo" del link; corrisponde a Descrizione oggetto
LLin = myLink.href 'href(cioe' url target) del link
'ora verifico se il link contiene "/prodotto/" e ".php?id"
If LTit <> "" And Len(LLin) = 17 + Len(Replace(Replace(LLin, "/prodotto/", ""), ".php?id", "")) Then
'se SI e' uno di quelli che mi interessano: inserisco su foglio Id, Descrizione, url
Cells(I + 1, 1) = Mid(LLin, InStr(1, LLin, ".php?id", vbTextCompare) + Len(".php?id"), 99)
Cells(I + 1, 2) = LTit
' Cells(I + 1, 3) = LLin
'inserisco url con associato hyperlink
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I + 1, 3), Address:=LLin, _
TextToDisplay:=LLin
I = I + 1
End If
Next myLink
'aaa = IE.document.body.outerHTML
'Cells(1, 6) = aaa
Stop '<<< Vedi testo
'Chiusura IE
Ie.Quit 'Chiudo IE
Set Ie = Nothing 'libero la variabile IE
End Sub
<div class="home-post-wrap" id="box_asta_76983__0" >
<div class="home-post-wrap-top">
<div class="date">
<a href="/prodotto/iphone-5.php?id=76983" style="color:#ffffff;" title="iPhone 5 16GB">iPhone 5 16GB</a>
</div>
</div>
MyConn = "URL;http://www.bidfun-it.com/bin/detail/147079"
With ActiveSheet.QueryTables.Add(Connection:=MyConn, _
.Destination:=Range("AA1"))
.Name = "www.google.it"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables ' non all perchè così mi selezione dopo le TABLES
.WebFormatting = xlWebFormattingAll
.WebTables = "6,9" ' così evito di importarmi tutta la pagina e visto che sono tutte uguali il risultato è corretto tranne :x 173905
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Torna a Applicazioni Office Windows
Powerline TP-LInk: come connetterli tra loro Autore: giovannib87 |
Forum: Reti, ADSL e wireless Risposte: 4 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
confrontare e evidenziare 2 fogli excel Autore: niccia |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 42 ospiti