Query Web da sito

[apocrimata75]

Salve a tutti vorrei il Vs aiuto, se possibile, per estrarre dati dal sito http://oddsdropping.com/index.php/en/

Purtroppo le queryweb non mi permettono di farlo, almeno per come le conosco io. Con il copia incolla riesco a estrarre ma perdo molto tempo, qualcuno saprebbe aiutarmi?

[raimea]

ciao
ma da quel sito che devi prelevare ?
ciao

[apocrimata75]

La tabella al centro contenente i dati (prelimiinarmente occorre scegliere "Hockey")

come da immagine
http://image.forumfree.it/8/2/5/0/3/1/3/1383595926.png

[apocrimata75]

[Anthony47]

Quelle pagine sono create da vari scripts, decodificandoli si potra' accedere alle informazioni richieste.
In attesa che qualcuno si cimenti (o offra uno spunto diverso) potresti leggere la tabella con un codice come questo:

Codice: Seleziona tutto

Sub GetTabbb()
'
myUrl = "http://www.oddsdropping.com/index.php/en/"
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 + 1 Or Timer < myStart Then Exit Do
Loop
'Leggi le tabelle, su un nuovo foglio
Worksheets.Add     '<<< Vedi testo
Cells.Clear

Set myColl = ie.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
With myColl(4)
    For Each trtr In .Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            Cells(I + 1, 1).Select
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
'Next myItm
End With
'Next II
Stop     'Vedi testo

IEQuit:
'Chiusura IE
ie.Quit
Set ie = Nothing
End Sub


La tabella sara' estratta (1) su un nuovo foglio, oppure (2) sul foglio corrente DOPO AZZERAMENTO SENZA PREAVVISO; per la scelta 2 eliminare l' istruzione marcata <<< (oppure "commentarla"), nel frattempo devi premere F5 per completare la macro.

Completata l' importazione la macro si fermera' (vedi istruzione Stop) per consentire di controllare se il risultato ricalca le attese.
Tuttavia il layout della tabella e' diverso graficamente da quanto visibile sul sito, eventualmente la devi riformattare come da tuo gradimento.

Ciao

[apocrimata75]

Grazie Anthony, funziona, sistemerò la formattazione in un'altra tabella per avere i dati cercati. Dovrei chiederti u'altra cosa però, la macro estrapola i dati della pagina relativa al calcio mentre vorrei ottenere solo i valori dell'hockey selezionandolo dal menu a sinistra come da immagine postata precedentemente, pensi/pensate si possa fare?

Grazie

[Anthony47]

L' immagine veramente non e' accessibile...
In prima battuta aggiungi questo Stop:

Codice: Seleziona tutto

Cells.Clear
Stop    '<<< Questo, in questa posizione
Set myColl = ie.document.getElementsByTagName("TABLE")

Questo ti consente di impostare a mano la scelta Hockey; poi premi F5 nella finestra del vba e la macro raccogliera' solo i dati di hockey.

In seconda battuta devo vedere se il sorgente consente di caricare la scelta hochey da vba, cosa che faro' "piu' in la"

Ma prima la webquery ti consentiva di scegliere quale sport?

Ciao

[apocrimata75]

Scusate x l'assenza ma siamo in tempi di chiusura e raggiungimento di target. Ho aggiunto lo Stop, seleziono "hockey" e volendo pure la data e la macro scarica i dati correttamente. La webquery non consentiva di scaricare nulla, dovevo fare copia e incolla, purtroppo. Vedo di sistemare in un'altra tabella intanto. Per ora grazie, spero si possa scaricare senza stop ed F5, ma già così è meglio.

[Anthony47]

Via macro si riesce a modificare i vari optionbox con il valore prescelto, es sport=Hockey, ma non scatta, sul web server, lo script di .change, quindi non viene aggiornato l' elenco dei match nel frame centrale.
Personalmente non so come si puo' attivare quello script, se non scatta modificando la scelta dell' option box; quindi per quello che so io ti tieni lo stop + F5 (col vantaggio che puoi variare a piacere ognuno dei listbox, non solo quello della selezione "sport").
Se mi viene qualche idea di successo non manchero' di scriverlo.

Ciao

[apocrimata75]

Codice: Seleziona tutto

Sub Macro8()
'
'
myUrl = "http://betvirus.com/leagueTables/67154/"
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 + 1 Or Timer < myStart Then Exit Do
Loop
'Leggi le tabelle, su un nuovo foglio
Worksheets.Add     '<<< Vedi testo
Cells.Clear

Set myColl = ie.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
With myColl(4)
    For Each trtr In .Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            Cells(I + 1, 1).Select
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
'Next myItm
End With
'Next II
SendKeys "{F5}", True
        SendKeys "{ENTER}", True
IEQuit:
'Chiusura IE
ie.Quit
Set ie = Nothing
End Sub


Per quella query ho rinunciato ma ho provato la macro su un altro sito e funziona pefettamente. Ho un quesito però: vorrei che scaricasse sempre sul foglio "xxxx" nella cella A1 invece di aggiungere un nuovo foglio, come posso fare?

[Anthony47]

Veramente l' avevo detto...
Invece di Worksheets.Add '<<< Vedi testo userai Sheets("xxxxx").Select
Ricorda che il contenuto di "xxxxx" verra' AZZERATO SENZA PREAVVISO all' avvio della macro.

Ciao

[apocrimata75]

Codice: Seleziona tutto

Sub Macro1()

myUrl = "http://betvirus.com/leagueTables/67154/"
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 + 1 Or Timer < myStart Then Exit Do
Loop
'Leggi le tabelle, su un nuovo foglio
Sheets("prova").Select     '<<< Vedi testo
Cells.Clear

Set myColl = ie.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
With myColl(4)
    For Each trtr In .Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            Cells(I + 1, 1).Select
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
'Next myItm
End With
'Next II
SendKeys "{F5}", True
        SendKeys "{ENTER}", True
IEQuit:
'Chiusura IE
ie.Quit
Set ie = Nothing
End Sub


Ho modificato la macro ed ora scarica nel foglio "prova". Ho notato però che la pagina web contiene almeno 3 tabelle e ne scarica solo una, la prima. Si può risolvere?

[Anthony47]

Quella macro serviva per estrarre la tabella che ci interessava dal sito http://oddsdropping.com/index.php/en/; se vuoi importare tutte le tabelle presenti nel sito betvirus.com/leagueTables/67154/ (e sono ben piu' di tre) userai quest' altra macro:

Codice: Seleziona tutto

Sub Macro2()

myUrl = "http://betvirus.com/leagueTables/67154/"
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 + 1 Or Timer < myStart Then Exit Do
Loop
'Leggi le tabelle su FoglioXX
Sheets("FOGLIO3").Select     '<<< Vedi testo
Cells.ClearContents

Set myColl = ie.document.getElementsByTagName("TABLE")
For Each myItm In myColl
    For Each trtr In myItm.Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            Cells(I + 1, 1).Select
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
Next myItm
'SendKeys "{F5}", True
'        SendKeys "{ENTER}", True
IEQuit:
'Chiusura IE
ie.Quit
Set ie = Nothing
End Sub


Per evitare che alcune colonne siano convertite erroneamente in date e' opportuno formattare le celle del foglio su cui importi (o almeno le colonne A:AC) come "Testo"
Ho commentato le linee "SendKeys", se ti servono ripristinale.

Ciao

[apocrimata75]

Anthony47 ho ripristinato le sendkeys e la formattazione di alcune colonne. Grazie mille, funziona perfettamente, ora provo a capire le differenze tra le 2 macro, xkè la prima scaricava una tabella e la seconda tutte, in modo da allargare le scarne conoscenze di excel.

Di nuovo grazie.

[Anthony47]

La differenza e' in questa area:
Prima macro

Codice: Seleziona tutto

Set myColl = ie.document.getElementsByTagName("TABLE")
With myColl(4)
    For Each trtr In .Rows
'...
End With


Seconda:

Codice: Seleziona tutto

Set myColl = ie.document.getElementsByTagName("TABLE")
For Each myItm In myColl
    For Each trtr In myItm.Rows
'...
Next myItm


Ciao

[apocrimata75]

Gentilissimo come sempre. Grazie

[apocrimata75]

Dopo innumerevoli tentaivi ho "creato" questa macro

Codice: Seleziona tutto

Sub Macro1()

myUrl = "http://betvirus.com/leagueTables/67154/"
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 + 1 Or Timer < myStart Then Exit Do
Loop
'Leggi le tabelle, su FoglioXX
Sheets("prova").Select '<<< Vedi testo
Cells.ClearContents

Set myColl = ie.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
MsgBox ("Numero anomalo di tabelle, abortito")
GoTo IEQuit
End If
With myColl(1)
For Each trtr In .Rows
For Each tdtd In trtr.Cells
Cells(I + 1, J + 1) = tdtd.innertext
Cells(I + 1, 1).Select
J = J + 1
Next tdtd
I = I + 1: J = 0
Next trtr
I = I + 2
Set myColl = ie.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
MsgBox ("Numero anomalo di tabelle, abortito")
GoTo IEQuit
End If
With myColl(7)
For Each trtr In .Rows
For Each tdtd In trtr.Cells
Cells(I + 1, J + 1) = tdtd.innertext
Cells(I + 1, 1).Select
J = J + 1
Next tdtd
I = I + 1: J = 0
Next trtr
I = I + 2
'Next myItm
End With
'Next II
SendKeys "{F5}", True
SendKeys "{ENTER}", True
IEQuit:
'Chiusura IE
ie.Quit
Set ie = Nothing
End With
End Sub

che estrae solo 2 delle tabelle presenti nell'URL, ma sballa la formattazione delle colonne gol tipo 10-12 li trasforma in data o numeri a 5 cifre. Ho provato a formattare come testo, come data gg-mm, numeri 00-00 ma il risultato non è mai stato quello sperato.


Dove sbaglio?

[Anthony47]

Devi formattare come "Testo" il foglio "prova prima di avviare la macro.

La macro puo' essere semplificata in

Codice: Seleziona tutto

Sub Macro11()

myUrl = "http://betvirus.com/leagueTables/67154/"
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 + 1 Or Timer < myStart Then Exit Do
Loop
'Leggi le tabelle, su FoglioXX
Sheets("prova").Select '<<< Vedi testo
Cells.ClearContents

Set myColl = ie.document.getElementsByTagName("TABLE")
If myColl.Length < 7 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
For JJ = 1 To 7 Step 6
    With myColl(JJ)
        For Each trtr In .Rows
            For Each tdtd In trtr.Cells
                Cells(I + 1, J + 1) = tdtd.innertext
                Cells(I + 1, 1).Select
                J = J + 1
            Next tdtd
            I = I + 1: J = 0
        Next trtr
        I = I + 2
    End With
Next JJ
'    End With
    SendKeys "{F5}", True
    SendKeys "{ENTER}", True
IEQuit:
    'Chiusura IE
    ie.Quit
    Set ie = Nothing
'    End With
    End Sub

Ciao

[apocrimata75]

nemmeno formattando funziona, provo ad estrapolare i dati diversamente

[Anthony47]

A me funziona....
Formattazione "Generale":

Uploaded with ImageShack.us

Formattazione "Testo":

Uploaded with ImageShack.us

Ne' vedo perche', con la formattazione Testo applicata su tutto il foglio, dovrebbe continuare a trasformare stringhe tipo 12-0 in dic-00 o nell' equivalente numero.
Aggiungendo questa istruzione inserisci la formattazione direttamente nella macro:

Codice: Seleziona tutto

'Leggi le tabelle, su FoglioXX
Sheets("prova").Select
Cells.ClearContents
Cells.NumberFormat = "@"                     '<<< QUESTA, qui


Ciao