[Excel]Query Web+Macro

[dragonedellenuvole]

Antony purtroppo di codice ne capisco ben poco, cerco di incollare codice a destra e sinistra ...Quello che vorrei fare è ottnere il risultato di asroma senza xò dover copiare il codice all interno di ogni macro..

http://www.fileden.com/files/2010/4/1/2813746//A1.xlsm

[Anthony47]

Nell' ipotesi che la mia interpretazione della tua domanda fosse stata esatta (cosa che non dici), allora devi copiare le prime dieci righe che ti ho dato subito dopo il titolo della macro esistente [quindi dopo la riga Sub ASROMA()]; devi prendere le ultime tre righe e metterle al posto di End Sub; devi sostituire la riga "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0001008876&" & Pag2 _
Con questa:

Codice: Seleziona tutto

    "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=" & MyIsin & "&" & Pag2 _


Poi devi fare il collaudo e dire se fa qualcosa simile a quello che chiedevi.

Tutte cose che non posso fare io.

Ciao

[rerasta]

Salve,
mi sono appena iscritto a questo forum per riprendere questo vecchio topic poichè ho un problema + o - simile

La differenza sta nel fatto che nel mio url, la pagina sta nel mezzo e non alla fine e pertanto non so come gestirla nella macro

esempio url

category.aspx?&Page=1&Sort=1&catid=14267
category.aspx?&Page=2&Sort=1&catid=14267

etc etc

Qualche consiglio?
Grazie in anticipo

[Anthony47]

Ciao rerasta, benvenuto nel forum.
Per capire meglio dovresti darci il riferimento alla pagina da agganciare (url completo: http://etc etc) e che cosa nella pagina vorresti estrarre.

Ciao

[rerasta]

purtroppo per problemi commerciali non posso rendere pubblico l'url completo....

attualmente uso questa macro per singola pagina ma essendo più di 100 pagine da importare è un bel problema

With ActiveSheet.QueryTables.Add(Connection:="URL;****.****.***/store/category.aspx?&Page=1&Sort=1&catid=14267", _
Destination:=Range("A1"))
.Name = "prova"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingAll
.WebTables = "25"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

[Anthony47]

Capisco... procedo quindi con raccomandazioni generali.

Mi pare che la tua domanda sia: ci sono tante pagine da raccogliere, come faccio?
Allora, diamo per scontato che la macro che hai postato dia un risultato soddisfacente per la pagina 1. Ciononostante ti chiedo di ripartire da un file nuovo, perche' tutte le volte che hai eseguito la macro hai creato una nuova query (cioe' adesso sul tuo foglio hai 1-10-100 query, in quantita' ignota), anche se con i dati tutti sovrapposti.
Parti quindi da un file nuovo e imposta la query che ti serve, senza produrre pero' nessuna macro.
A questo punto, se il problema e' eseguire la query su N pagine, accodando i dati, manda in esecuzione questa macro che esequira' la query N volte quante sono le pagine che devi prelevare:

Codice: Seleziona tutto

    Sub QWloop()
    For N = 1 To 23    '<<< QUANTE SONO le pagine da prelevare
      NewConn = "URL;http://www.xxxxx.yy.zz/.../category.aspx?&Page=" & N & "&Sort=1&catid=14267"
      NewDest = Range("B" & Rows.Count).End(xlUp).Offset(1, -1).Address
      ActiveSheet.QueryTables(1).Connection = NewConn
      ActiveSheet.QueryTables(1).Destination = Range(NewDest)
      ActiveSheet.QueryTables(1).Refresh
    Next N
    End Sub


E' importante che sul tuo foglio ci sia una sola query, quindi se la query che imposti non produce i risultati che vuoi non devi crearne una nuova, ma MODIFICARE quella precedente.
Controlla anche tra le "Proprietà" della query sia tolta la spunta ad Abilita aggiornamento in background e ad Aggiorna ogni XX minuti.

Fai sapere, ciao.

[rerasta]

grazie mille x l'aiuto

Ho seguito la tua spiegazione ma noto che tutte le pagine importate si sovrascrivono e solo l'ultima rimane visibile nel foglio

Tieni presente che la pagina è importata in 4 colonne (a-b-c-d) partendo dalla riga A1
La pagina successiva alla n.1 vorrei venisse importata nella prima riga vuota della colonna A

[Anthony47]

Ho seguito la tua spiegazione ma noto che tutte le pagine importate si sovrascrivono e solo l'ultima rimane visibile nel foglio

Infatti ho usato il metodo .Destination che pero' e' di sola lettura e quindi non serve a niente.
Non ho trovato al volo cosa usare per cambiare "destination" di una query esistente, devo guardare nella doc microsoft ma mi richiede un po' di tempo, porta pazienza.
In alternativa tieni la query che scrive tutto nella stessa posizione di un foglio di servizio del tuo file, e dopo il refresh (quindi prima di Next N) inserisci il codice per copiare sul foglio finale i dati prelevati dalla query, accodandoli ai dati preesistenti.

A presto.

[Anthony47]

Non ho trovato un modo per variare la destinazione di una web query esistente, che non significa che non esiste.
Al momento, quindi, o segui il consiglio di eseguire la query in una destinazione fissa di servizio e quindi procedi ad accodare in altra area i risultati ottenuti; oppure inserisci la macro con cui generi la query in un loop, previa cancellazione della query precedente.
Qualcosa del tipo

Codice: Seleziona tutto

Sub QWloop()
For N = 1 To 23    '<<< QUANTE SONO le pagine da prelevare
'
On Error Resume Next
ActiveSheet.QueryTables("pippo").Delete    'Cancella la query
On Error GoTo 0
NewConn = "URL;http://www.xxxxxxx.yy.zz/..../category.aspx?&Page=" & N & "&Sort=1&catid=14267"
NewDest = Range("B" & Rows.Count).End(xlUp).Offset(1, -1).Address
'Range(NewDest).Select
'
'Da qui e' QUASI come la tua macro originale
With ActiveSheet.QueryTables.Add(Connection:=NewConn, Destination:=Range(NewDest))    '<< Esistente ma Modificata
        .Name = "pippo"                  '<< esistente ma Modificata
        .FieldNames = True            '<< Esistente
'altre istruzioni
'altre istruzioni
        .Refresh BackgroundQuery:=False    '<< Esistente
    End With    '<< Esistente
Next N          '<<< Aggiunta
End Sub


Ciao

[rerasta]

ottimo direi !!!! era proprio quello che stavo cercando
grazie mille

[cipacci]

Salve a tutti, eccomi di nuovo qui a chiedere il vostro aiuto ;

Sto cercando di creare una macro in excel simile a quanto indicato in questo 3d da dragonedellenuvole e rerasta, in quanto anch'io necessito di importare dei dati da un sito web e devo farlo per più giorni;
ho provato a copiare il codice come indicato qui http://www.pc-facile.com/forum/viewtopic.php?f=26&t=88282#p502276, creando anche il foglio "Indice" con l'instestazione della colonna A in "MyIsin" per calcolare l'URL, ma mi da un errore: nello specifico quando lancio la query mi dice: "Indice non incluso nell'intervallo";
il codice che ho trascritto è questo:

Codice: Seleziona tutto

Sub DatiQuery()

For Each MyIsin In Sheets("Indice").Range("A2:A86")  '<< Nome Foglio e intervallo codici ISIN
If MyIsin.Value = "" Then GoTo Skippa
On Error Resume Next: CCC = ""
CCC = Sheets(MyIsin.Offset(0, 1).Value).Name
If CCC = "" Then
    Sheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = MyIsin.Offset(0, 1).Value
    End If
    On Error GoTo 0
Sheets(MyIsin.Offset(0, 1).Value).Select

Application.ScreenUpdating = False
Application.Calculation = xlManual
Cells.Select
Selection.Clear
    On Error Resume Next
Selection.QueryTable.Delete
    On Error GoTo 0
Range("A1").Select
UR = 1
[Z1] = Timer
For Rip = 0 To 90
    For Each RName In ThisWorkbook.Names
        RName.Delete
    Next RName

With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://data.nowgoal.com/1x2/bet007history.htm?id=&company=&matchdate=" & MyIsin _
            , Destination:=Range("A" & UR))
            .Name = "bet007history.htm?id=&company=&matchdate="
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .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
       
        UR = Worksheets("Foglio2").Range("A" & Rows.Count).End(xlUp).Row + 1
        If Range("A" & UR - 1).Text = "Ora" Then
            If UR > 1 And Range("A" & UR - 1).Text = "Ora" Then Rows(UR - 1 & ":" & UR - 1).Delete
            GoTo Salta
        End If
    If UR > 1 And Range("A" & UR).Text = "Ora" Then Rows(UR & ":" & UR).Delete
    Range("A" & UR).Select
Next Rip
Salta:
    Range("A1").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
[Z2] = Timer
Skippa:
Next MyIsin
End Sub


Naturalmente avrò fatto dei casini, data la mia completa ignoranza in materia, ma non riesco a capire dove. ho fatto diversi tentativi ma nulla... mi restituisce sempre lo stesso errore.
Il codice l'ho copiato in "Thisworkbook".

Mi date una mano anche a me?
Grazie
ciao

[cipacci]

facendo ulteriori ricerce su google sull'errore "... run-time'9' ..." ho trovato questo http://msdn.microsoft.com/it-it/library/y06c9ce1(v=vs.80).aspx ma non ho capito cosa devo modificare... Nel foglio "Indice" nella colonna A, dalla cella A2 alla cella A87 ci sono i valori che andranno a formare la URL, la quale, a sua volta, andrà a scaricare i dati da web e inserirli in un foglio.... nel codice ho scritto

For Each MyIsin In Sheets("Indice").Range("A2:A87")

perchè mi da l'errore qui:

Sheets(MyIsin.Offset(0, 1).Value).Select

???
Grazie ancora
ciao

[Anthony47]

Quell' errore ragionevomente significa che si sta cercando di indirizzare un foglio con un nome inesistente.
La struttura dati prevede un elenco (in A2:A87) e nella colonna adiacente (quindi B2:B87) il nome dei fogli su cui i dati dovrebbero essere trasferiti; se il foglio manca allora viene creato.
Cio' detto, quindi, la cosa piu' probabile che sia stato indicato in B2:B87 un nome foglio sintatticamente errato, ad esempio vuoto o contenente caratteri proibiti, quali : / \ * e altri che puoi trovare nell' help on line di excel.
Ispeziona quindi il contenuto di B2:B87 per verificare cosa vi e' scritto; in ogni caso puoi avere maggiore evidenza dell' errore inserendo questa istruzione:

Codice: Seleziona tutto

On Error Resume Next: CCC = ""
CCC = Sheets(MyIsin.Offset(0, 1).Value).Name
On Error GoTo 0       '<<< AGGIUNGERE QUESTA, QUI
If CCC = "" Then


Inoltre il codice non va scritto in ThisWorkbook, ma in un Modulo standard di codice; se non ne esistono ancora basta fare Menu /Inserisci /Modulo.

Ciao

[serra]

Salve, so che è un post vecchio, ma spero di trovare comunque aiuto perchè molto inerente e credo basti davvero poco per risolvere il mio problema
Come l'utente precedente da una lista di isin, devo creare le query in automatico, una per foglio attraverso la macro.
il link di esempio di un paio di opzioni è:
http://www.borsaitaliana.it/borsa/derivati/ftse-mib-options/scheda/IT0014378357.html?lang=it
http://www.borsaitaliana.it/borsa/derivati/ftse-mib-options/scheda/IT0014233230.html?lang=it
Come potete vedere cambia solo l'isin che ho già inserito in un foglio apposta come indicato nei post precedenti.
Il punto è che quando provo a eseguire il codice ricavato da questo post adattato o si blocca, o nei fogli creati non carica la pagina completa ma solo un paio di righe
Provo a postare il codice usato finora, sperando che qualcuno mi possa aiutare:

Codice: Seleziona tutto

Sub DatiQuery()
For Each MyIsin In Sheets("CSTRIKES").Range("A2:A3")  '<< Nome Foglio e intervallo codici ISIN
If MyIsin.Value = "" Then GoTo Skippa
On Error Resume Next: CCC = ""
CCC = Sheets(MyIsin.Offset(0, 1).Value).Name
If CCC = "" Then
    Sheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = MyIsin.Offset(0, 1).Value
    End If
    On Error GoTo 0
Sheets(MyIsin.Offset(0, 1).Value).Select

Application.ScreenUpdating = False
Application.Calculation = xlManual
Cells.Select
Selection.Clear
    On Error Resume Next
Selection.QueryTable.Delete
    On Error GoTo 0
Range("A1").Select
UR = 1
[Z1] = Timer
For Rip = 0 To 90
    For Each RName In ThisWorkbook.Names
        RName.Delete
    Next RName

With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://www.borsaitaliana.it/borsa/derivati/ftse-mib-options/scheda/" & MyIsin & ".html?lang=it" _
            , Destination:=Range("A" & UR))
            .Name = "Call"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .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
       
        UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row + 1
        If Range("A" & UR - 1).Text = "Ora" Then
            If UR > 1 And Range("A" & UR - 1).Text = "Ora" Then Rows(UR - 1 & ":" & UR - 1).Delete
            GoTo Salta
        End If
    If UR > 1 And Range("A" & UR).Text = "Ora" Then Rows(UR & ":" & UR).Delete
    Range("A" & UR).Select
Salta:
    Range("A1").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
[Z2] = Timer
Skippa:
Next MyIsin

End Sub


[Anthony47]

Questi siti espongono in modo anomalo i numeri delle tabelle presenti; ora io non so quale tra le varie tabelle presenti a te interessi, comunque prova a modificare questa istruzione
.WebTables = "4"
in

Codice: Seleziona tutto

.WebTables = "1,2"

Secondo me queste sono le tabelle che cerchi, eventualmente modifica in "1,2,3,4,5,6" cosi' dovresti importare tutte le 6 che sono presenti; oppure per prova individua quella/quelle che ti interessano; devi variare la sequenza tra virgolette, es "2,4" significa tab 2 e 4.

Se cosi' non risolvi allora spiega quale area ti interessa (ad esempio facendo uno screenshot) e vedremo cosa si puo' fare.
Per le istruzioni su come allegare una immagine:
viewtopic.php?f=26&t=103893&p=605488#p605488

Ciao

[serra]

Ti ringrazio per la risposta, credo di aver risolto, eliminando tutte le altre voci sotto alla query, ora non dà più problemi