prelevare da web

[raimea]

ciao a tutti
sto tentando di riuscire a prelevare una pagina web
e mettere il contenuto in un foglio excell.
ho letto parecchi forum , ho capito che serve un codice ecc...
ma non ci riesco.
in altri file usa questo cod.

Codice: Seleziona tutto

With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.betonews.com/table.asp?", Destination:=Range( _
        "$A$1"))
        '.Name = "?page_id=108"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

ma qui non mi funziona , non riesco ad adattarlo.

provo a descrivere:

la pagina con i dati da prelevare e' questa:
http://www.betonews.com/table.asp?tp=2001&lang=en&dd=27&dm=2&dy=2013&df=1&dw=3

dove --> en&dd=27&dm=2&dy=2013varia ogni giorno ed indica la data odierna.

i dati copiati vorrei metterli nel foglio prelievo da cella D6.
mi serve dalla colonna SN fino --> TOTAL.

io ora faccio un copia-incolla semplice , solo che mi copia anche le bandiere, palloni, frecce ecc..
se possibile non prelevare "i disegnini" bandiere, frecce, ecc xche' poi nel
cancellare questi li devo eliminare a mano....

questo il file:
http://dl.dropbox.com/u/96374724/luga.roserpina.1%2C4.rar

grazie
ciao

[Anthony47]

Partiamo dal fatto che le web query vanno in crisi su pagine create dinamicamente tramite script (vedi http://support.microsoft.com/kb/277899/en-us).
Quindi il mio suggerimento e' di usare funzioni, metodi e proprieta' rese disponibili dalla libreria mshtml.tlb, corrispondente alla voce Microsoft html object library dell' editor delle macro, sulla falsariga di altre automazioni simili gia' presentate, ad esempio viewtopic.php?f=26&t=97268#p558449, oppure viewtopic.php?f=26&t=97767#p561571, viewtopic.php?t=98113 e altri sul forum o altrove.

La premessa e' l' analisi del codice html della pagina web, per individuare quali attributi caratterizzano la componente da prelevare; nel nostro caso si tratta di "tabelle", indirizzabili tramite il tag <table>. Purtroppo non ci sono elementi utili a selezionare quella delle 43 tabelle presenti che ci interessa (in genere si ricorre ad attributi quali Id, o Class o Name); si potrebbe usare l' ordine (e' la 25a tabella), ma ho preferito utilizzare la presenza del termine "Away Team" come flag.
Cio' detto, una macro come questa porta la tabella che hai citato nel foglio "prelievo", da A6 in giu':

Codice: Seleziona tutto

Sub GetTabRaim()
Dim BetFlag As Boolean

myUrl = "http://www.betonews.com/table.asp?tp=2001&lang=en&dd=24&dm=2&dy=2013&df=1&dw=3"
Set ie = CreateObject("InternetExplorer.Application")
   
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  'attesa addizionale
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop

'Leggi le tabelle, su un nuovo foglio
Worksheets("prelievo").Select
Range("A6").CurrentRegion.Clear

I = 5
Set mycoll = ie.document.getElementsByTagName("TABLE")
aaa = mycoll.Length
For Each myItm In mycoll
BetFlag = False
    For Each trtr In myItm.Rows
'[C2] = trtr.innertext: Call Macro1
    If Len(trtr.innertext) > Len(Replace(trtr.innertext, "Away Team", "")) And Len(trtr.innertext) < 10000 Then
        BetFlag = True
    End If
        For Each tdtd In trtr.Cells
        DoEvents
                If BetFlag Then
                    Cells(I + 1, J + 1) = tdtd.innertext
                    J = J + 1
                End If
        Next tdtd
        If BetFlag Then I = I + 1: J = 0
    Next trtr
If BetFlag Then I = I + 1
Next myItm

Stop     'Vedi testo

'Chiusura IE
ie.Quit
Set ie = Nothing

End Sub


Nei miei test la macro impiega parecchio tempo prima entrare nello stato readyState =4 (DocumentComplete); anche se a schermo la paginata sembra gia' stabile preferisco non derogare dalla regola che dice che solo readyState = 4 garantisce il documento in memoria. Inoltre ho inserito uno Stop per consentire la verifica che l' importazione sia corretta; dopo il debug l' istruzione puo' essere "commentata" o eliminata.

Prova e fai sapere se idoneo.

Ciao

[raimea]

ciao
spiegazione molto complete e professionali.

ho messo la macro in un nuovo modulo.
sembra che vada (non ho nessun errore), apre la relativa pagina indicata,
ma poi non succede piu nulla,
ho letto che impiega parecchio tempo , ma indicativ. di quanto stiamo parlando ?
per potermi rendere conteo.

grazie
ciao

[raimea]

ok
dopo 7-8 min,
la macro ha prelevato i dati che volevo.

poi si e' bloccata qui --->

Codice: Seleziona tutto

Stop     'Vedi testo

cosa devo fare ?

inoltre:
l'ndirizzo da prelevare fa riferimento al gg del 24.2.13
e' possibile far si che prelevi sempre la data odierna ?
se negativo mi va bene anche cosi , modifichero manualmente l'indirizzo

ciao

[Anthony47]

Nel mio test impiega circa 90 secondi, durante i quali ricevo circa 2.8 MByte di dati; il solo sorgente e' lungo circa 400k caratteri, e occupa 190 pagine di word, e non so decodificarne il contenuto se non per gli aspetti piu' elementari.

Per quanto riguarda la modifica della data, devi solo articolare l' url in funzione della data; ad esempio, invece della stringa fissa devi calcolare myUrl come segue:

Codice: Seleziona tutto

myDate = Int(Now())
myUrl = "http://www.betonews.com/table.asp?tp=2001&lang=en&dd=" & Day(myDate) _
    & "&dm=" & Month(myDate) & "&dy=" & Year(myDate) & "&df=1&dw=3"


(nell' esempio myDate e' compilata con la data odierna, ma puo' essere una data qualsiasi)

Per quanto riguarda il fatto che si fermi su Stop, l' avevo scritto al 90%:

Inoltre ho inserito uno Stop per consentire la verifica che l' importazione sia corretta; dopo il debug l' istruzione puo' essere "commentata" o eliminata.

Il 10% mancante e' che dopo aver eseguito la verifica devi premere F5 per completare le successive istruzioni, che terminano la sessione InternetExplorer associata alla macro.

Ciao

[raimea]

ciao
ho sistemato lo --> stop
ho sistemato x far prelevare sempre la data odierna.

grazie
delle belle spiegazioni
ciao

[raimea]

ciao
la macro --> GetTabRaim()
fa un po' i capricci...
e non so' perche'..

alcune volte va, poi altre non va , ma non capisco perche' ???

si blocca qui--> aaa = mycoll.Length

e scrive--> errore di compilazione, prevista function o variabile...

allego il file

http://dl.dropbox.com/u/96374724/ormon%26roserpina.1%2C5.rar


ciao

[Anthony47]

Cancella quella riga, mi serviva solo durante il test.
Curiosita', tu lavori solo su XL2003?

Ciao

[raimea]

ciao
ok , riga cancellata ora funge.

si' uso solo offc. 2003.

mi consigli di passare a off 2010 ?
o meglio restare qui ?

grazie
ciao

[Anthony47]

Non ti consiglio di passare a XL2010, ma so che prima o poi sarai costretto a passarci e penerai a scoprire dove sono i comandi che hai sempre usato.
Facevo la domanda perche' ho anche io notato che talvolta in XL2010 "la variabile aaa" viene interpretata come "la colonna aaa", causando quell' errore; ma in XL2003 questo non dovrebbe succedere...

Ciao

[raimea]

a ok.
grazie del consiglio
terro' 2003 finche ci riusciro'
ciao

[raimea]

ciao
dopo aver prelevato , vorrei copiare in un altro foglio
solo cio' che mi serve tramite un doppio clik , (se possibile).

nel fgl prelievo ho i dati prelevati, vorrei copiare le righe che mi interessano
tramite un doppio clik in col . A, copiare il contenuto riga dalla col B:Q
e incollare solo i dati , nel fgl --> studio & info dalla riga 6 da col C.

dovrei incollare stando attento a incollare nella prima riga disponibile
cioe' al 1mo clik incollo in riga 6 al 2do in riga 7 (se la 6 e' piena...)

questo il file:

http://dl.dropbox.com/u/96374724/luga.progressioni_2.7%20-%20Copia.rar

ciao

[Anthony47]

Perdona, ricordo che in vba te la cavi benino, non capisco quindi su che cosa stai chiedendo un aiutino...
L' evento Worksheet_BeforeDoubleClick lo gestisci come tutti gli eventi sul modulo di codice del foglio su cui lavori (come fai con i Worksheet_Change o Worksheet_SelectionChange) e nello stesso modo controlli se il doppioclick e' avvenuto in una tua CheckArea; copiare un' area adiacente a quella su cui clicchi lo fai in 10 modi diversi ma simili, ad esempio Target.Offset(0,1).resize(1,16).Copy copia le colonne B:Q, se il doppioclick e' sulla colonna A; trovare l' ultima riga di un foglio lo facciamo da quando eravamo piccoli; fare incolla speciale pure...
Insomma, che cosa non ho capito??

Ciao, ti aspettiamo.

[raimea]

ciao

ricordo che in vba te la cavi benino,

si' , e vero,
ma cio che chiedo non sono riuscito a farlo,

io "smanetto" bene fin tanto devo operare su una macro registrata,
riesco a modoficarla e altre piccole cose , ma certi passaggi certi codici,
non ci riesco , e GRAZIE a tutti voi ho realizzato file molto completi.

tornando alla richiesta sopra , un pezzo di macro (penso corretto ) l'ho fatto
ma poi il passaggio successivo lo canno sempre....
ecco perche' ho scritto nel forum.

Codice: Seleziona tutto

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Me.Range("a6:a500")) Is Nothing Then

Target.Offset(0,1).resize(1,16).Copy
 
End If
End Sub

grazie
ciao

[Gigi_]

Prova un po' questo.
Se ti piace e ne hai bisogno faremo luce sul codice, frutto di ricerche in giro ed ovviamente su pc-facile.com!
E' velocissimo, carica i dati in 5/6 secondi

Codice: Seleziona tutto

Option Base 1
Public objIE As Object
Public a As Variant
Public url As String
Public linkpb(500, 15) As String
Public p(12, 6) As Variant
Public ck(6, 500) As Variant
Public rif, rifrif, fine, inizio As Variant

Sub estrailinkpb()
myDate = Int(Now())
url = "http://www.betonews.com/table.asp?tp=2001&lang=en&dd=" & Day(myDate) _
    & "&dm=" & Month(myDate) & "&dy=" & Year(myDate) & "&df=1&dw=3"

Naviga (url)
   
parametri
            rifrif = 0
            For link = 1 To Sheets("Foglio3").Cells(1, 1).Value
                    For data = 1 To 12
                            ck(2, link) = InStr(rifrif + 1, a, p(data, 2))
                            ck(3, link) = InStr(ck(2, link), a, p(data, 3)) + p(data, 5)
                            ck(4, link) = InStr(ck(3, link), a, p(data, 4))
                            linkpb(link, data) = Mid(a, ck(3, link), ck(4, link) - ck(3, link))
                            rifrif = ck(4, link)
                            Sheets("Foglio1").Cells(link, data).Value = linkpb(link, data)
                    Next data
            Next link
        selezionate
End Sub
Sub selezionate()
For i = 1 To 1000
sel = Sheets("Foglio3").Cells(i, 2).Value
If sel <> "" Then
For ii = 1 To 12
Sheets("Foglio2").Cells(i, ii).Value = Sheets("Foglio1").Cells(sel, ii).Value
Next ii
Else
i = 1000
End If
Next i
End Sub

Sub parametri()

v = 1
p(v, 2) = "tbl_black_n_"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1

End Sub
Sub Naviga(url)
a = ""
On Error Resume Next
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = False
    objIE.Navigate url
    c1 = Time
    Do While objIE.busy
    DoEvents
    If Time > c1 + TimeValue("00:00:30") Then Exit Do
    Loop    'opzionale, loop se non completato
    a = objIE.document.body.innerHTML
    'Range("a1").Value = a
b = Len(a)
                    Resume
                    closeIE
If a = "" Then
closeIE
Naviga (url)
End If
If Len(a) < 2500 Then
closeIE
Application.Wait Now + TimeValue("00:01:00")
Naviga (url)
End If
End Sub
Sub closeIE()
    On Error Resume Next
    objIE.Quit
    Set objIE = Nothing
End Sub

Comunque quì c'è il file di esempio.
http://www.mediafire.com/view/?y2dmswrxtod8h3x

[raimea]

Prova un po' questo.
Se ti piace e ne hai bisogno faremo luce sul codice, frutto di ricerche in giro ed ovviamente su pc-facile.com!
E' velocissimo, carica i dati in 5/6 secondi

Codice: Seleziona tutto

Option Base 1
Public objIE As Object
Public a As Variant
Public url As String
Public linkpb(500, 15) As String
Public p(12, 6) As Variant
Public ck(6, 500) As Variant
Public rif, rifrif, fine, inizio As Variant

Sub estrailinkpb()
myDate = Int(Now())
url = "http://www.betonews.com/table.asp?tp=2001&lang=en&dd=" & Day(myDate) _
    & "&dm=" & Month(myDate) & "&dy=" & Year(myDate) & "&df=1&dw=3"

Naviga (url)
   
parametri
            rifrif = 0
            For link = 1 To Sheets("Foglio3").Cells(1, 1).Value
                    For data = 1 To 12
                            ck(2, link) = InStr(rifrif + 1, a, p(data, 2))
                            ck(3, link) = InStr(ck(2, link), a, p(data, 3)) + p(data, 5)
                            ck(4, link) = InStr(ck(3, link), a, p(data, 4))
                            linkpb(link, data) = Mid(a, ck(3, link), ck(4, link) - ck(3, link))
                            rifrif = ck(4, link)
                            Sheets("Foglio1").Cells(link, data).Value = linkpb(link, data)
                    Next data
            Next link
        selezionate
End Sub
Sub selezionate()
For i = 1 To 1000
sel = Sheets("Foglio3").Cells(i, 2).Value
If sel <> "" Then
For ii = 1 To 12
Sheets("Foglio2").Cells(i, ii).Value = Sheets("Foglio1").Cells(sel, ii).Value
Next ii
Else
i = 1000
End If
Next i
End Sub

Sub parametri()

v = 1
p(v, 2) = "tbl_black_n_"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "noWrap"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title="
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "right"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1
v = v + 1
p(v, 2) = "title"
p(v, 3) = ">"
p(v, 4) = "<"
p(v, 5) = 1

End Sub
Sub Naviga(url)
a = ""
On Error Resume Next
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = False
    objIE.Navigate url
    c1 = Time
    Do While objIE.busy
    DoEvents
    If Time > c1 + TimeValue("00:00:30") Then Exit Do
    Loop    'opzionale, loop se non completato
    a = objIE.document.body.innerHTML
    'Range("a1").Value = a
b = Len(a)
                    Resume
                    closeIE
If a = "" Then
closeIE
Naviga (url)
End If
If Len(a) < 2500 Then
closeIE
Application.Wait Now + TimeValue("00:01:00")
Naviga (url)
End If
End Sub
Sub closeIE()
    On Error Resume Next
    objIE.Quit
    Set objIE = Nothing
End Sub

Comunque quì c'è il file di esempio.
http://www.mediafire.com/view/?y2dmswrxtod8h3x

-----------------------------------------------
ok
grazie
ma la mia ultima richiesta e' diversa..
raimea
ciao

[Gigi_]

Non ne sono sicuro, diciamo che sono stato laconico. Mea culpa.
Chiaramente all'inizio nel
Foglio3 cella A1 va inserito il numero delle righe della tabella da caricare (oggi per esempio ne ha 47)
nella colonna B bisogna elencare le righe di tuo interesse (esempio la 12 b1, 13 b2 17 b3 etc) e queste saranno caricate nel Foglio2 .

[raimea]

haaa cosi va gia meglio...
mea culpa non avevo capito subito....
mo ci do un occhio
x ora grazie

[raimea]

ciao
grazie al SUPER aiuto di gigi_
ho seguito i suoi consigli ed ho risolto come da sue preziose indicazioni
(e super codice).

quindi ora:
scrivendo il numero delle partite che mi interessano
ad ogni prelievo tali partite vengono riportate automaticamente nel fgl studio.
grazie
ciao

[raimea]

ciao
altre all' ottima macro di gig_
sono riuscito anche mettere la mia richiesta iniziale,
cioe' far si' che: su 2ppio click in col A del fogl prelievo, porta tale partita in fgl studio.

questo il cod nel fgl prelievo:

Codice: Seleziona tutto

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim riga As Long
Dim area As Range
Set area = Me.Range("B9:B1000")
riga = Target.Row
Sheets("prelievo").Range("A" & riga & ":" & "r" & riga).Select
Selection.Copy
Sheets("studio & info").Select
Dim UR As Long 'scegli la colonna
    UR = Sheets("studio & info").Range("B" & Rows.Count).End(xlUp).Row + 1 'prima riga libera della colonna A
    If UR < 6 Then UR = 6 'a partire dalla riga 6
    Sheets("studio & info").Cells(UR, 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub


ciao
e auguri a tutti.