importazione sito web

[maxrub]

Ciao, devo importare dei dati da un sito web:

Codice: Seleziona tutto

Sub Pulsante1_Click()

     Sheets("1X2").Select
Cells.Select
Selection.ClearContents
'With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
      & fpath & fname, Destination:=Range("A1"))
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://data.nowgoal.com/1x2/index.htm" _
        , Destination:=Range("A1"))
        .Name = "results"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
 End Sub

Il problema è che la colonna con la data/ora della partita non viene importata. Grazie dell'aiuto.

[Anthony47]

Il problema è che la colonna con la data/ora della partita non viene importata

Veramente a me pare che la web query da quel sito non ti importa NESSUN dato utile... Ma e' normale che le web query vanno in crisi su pagine create dinamicamente tramite script (vedi http://support.microsoft.com/kb/277899/en-us).
Comunque una macro come questa ti riportera' nel foglio che vuoi tu tutte le tabelle che sono presenti a quell' indirizzo:

Codice: Seleziona tutto

Sub GetWebTab()
'
myURL = "//data.nowgoal.com/1x2/index.htm"     '<<<<
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.Add
'Application.Goto (Sheets("Foglio1").Range("A1"))
'Cells.Clear
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
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 1
Next myItm

Stop     'Vedi testo

'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub


Il layout non e' ordinatissimo, visto la presenza di righe dichiarate rowspan="2", ma e' ripetitivo, quindi puo' essere ordinato separatamente.

Quanto sopra usa dettagli leggibili nel sorgente html; niente garantisce che questi dettagli non verranno cambiati stanotte, o a fine settimana, o a fine mese; non e' escluso quindi che la macro sara' da aggiornare di tanto in tanto.
La macro si ferma su Stop per consentire il controllo di allineamento dei dati sul sito con i dati importati; terminato il debug la riga Stop puo' essere eliminata

Discussioni analoghe alla tua:
viewtopic.php?p=580649
viewtopic.php?f=26&t=97268
viewtopic.php?f=26&t=97767
viewtopic.php?t=98113

Ciao