Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Importa da sito

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Importa da sito

Postdi apocrimata75 » 22/03/14 11:04

Ho trovato un altro sito che preferisce oscurare i suoi dati durante l'importazione su foglio excel.

Ho provato con le queryweb e "restituisce" solo alcuni dati che invece a video risultano presenti. Memore di altro post ho provato con la macro

Codice: Seleziona tutto
Sub pipp()

myUrl = "http://www.progsport.com/icehockey/"
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("Foglio4").Select     '<<< Vedi testo

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

Set myColl = IE.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
With myColl(5)
    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

Set myColl = IE.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
With myColl(10)
    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

SendKeys "{F5}", True
        SendKeys "{ENTER}", True

   
   End Sub


ma non importa niente.

Ho provato con
Codice: Seleziona tutto
Sub Macro4()

Sheets("Foglio4").Select


myUrl = "http://www.progsport.com/icehockey/"
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("Foglio4").Select     '<<< Vedi testo

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

Set myColl = IE.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
With myColl(5)
    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

Set myColl = IE.document.getElementsByTagName("TABLE")
If myColl.Length < 5 Then
    MsgBox ("Numero anomalo di tabelle, abortito")
    GoTo IEQuit
End If
With myColl(10)
    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

SendKeys "{F5}", True
        SendKeys "{ENTER}", True

   End Sub

ma non importa i valori nascosti.


Ci sono altre soluzioni?

Grazie anticipatamente.
Windows 7 - Office 2010
apocrimata75
Utente Senior
 
Post: 181
Iscritto il: 28/05/11 13:22

Sponsor
 

Re: Importa da sito

Postdi scossa » 23/03/14 16:43

apocrimata75 ha scritto:Ho trovato un altro sito che preferisce oscurare i suoi dati durante l'importazione su foglio excel.

Ho provato con le queryweb e "restituisce" solo alcuni dati che invece a video risultano presenti.


Purtroppo i "furbetti" di quel sito hanno sostituito le singole cifre che compongono i valori delle "outcome prediction (%)" con delle GIF.
Quindi l'unico modo è di convertire il nome della gif nella relativo cifra.

Ho modificato il codice per fare questo.

Condizioni: nelle righe 4 e 5 del "Foglio4" contengono le intestazione che scriverai tu:

Codice: Seleziona tutto
ΜATCHES       OUTCOME PREDICTION(%)               AVERAGE ODDS      UNDER/OVER      FINAL
HOME team  -   AWAY team   1    X    2   TIPS      1    X    2    5.5-    5.5+      RESULT


Questo il codice:
Codice: Seleziona tutto
Sub pippo()
  Dim myUrl As String
  Dim ie As Object
  Dim myColl As Object
  Dim mySubColl As Object
  Dim trtr As Object
  Dim tdtd As Object
  Dim imgimg As Object
  Dim prepre As Object
  Dim myStart As Single
  Dim nRoff As Long
  Dim nCoff As Long
  Dim sNum As String
  Dim rngTo As Range
  Dim nTd As Integer
  Dim bImg As Boolean
 
  Set rngTo = ThisWorkbook.Worksheets("Foglio4").Range("A6")
  rngTo.Resize(Cells(Rows.Count, 1).End(xlUp).Row, 12).ClearContents
  myUrl = "http://www.progsport.com/icehockey/"
  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("Foglio1").Select     '<<< Vedi testo
 
  Set myColl = ie.document.getElementsByTagName("TABLE").Item(5)
  Set mySubColl = myColl.getElementsByTagName("TR")
  nRoff = 0
  nCoff = 0
  For Each trtr In mySubColl
    For Each imgimg In trtr.getElementsByTagName("IMG")
      If imgimg.classname Like "im" Then
        rngTo.Offset(nRoff, nCoff).Value = imgimg.parentelement.innertext
      End If
    Next
    If trtr.classname Like "f?" Then nRoff = nRoff + 1
  Next
  nRoff = 0
  nCoff = 1
  Set mySubColl = myColl.getElementsByTagName("PRE")
  For Each prepre In mySubColl
    rngTo.Offset(nRoff, nCoff) = Trim(prepre.innertext)
    nRoff = nRoff + 1
  Next
  Set mySubColl = myColl.getElementsByTagName("TR")
  bImg = True
  nRoff = 0
  nTd = 1
  nCoff = 2
      For Each tdtd In myColl.getElementsByTagName("TD")
       
        If tdtd.classname Like "po*" And bImg Then
          'nTd = nTd + 1
          sNum = ""
          For Each imgimg In tdtd.Children
            Select Case imgimg.nameprop
              Case "A2.gif"
                sNum = sNum & "1"
              Case "B2.gif"
                sNum = sNum & "9"
              Case "C2.gif"
                sNum = sNum & "3"
              Case "D2.gif"
                sNum = sNum & "6"
              Case "E2.gif"
                sNum = sNum & "0"
              Case "F2.gif"
                sNum = sNum & "8"
              Case "G2.gif"
                sNum = sNum & "7"
              Case "H2.gif"
                sNum = sNum & "2"
              Case "K2.gif"
                sNum = sNum & "4"
              Case "L2.gif"
                sNum = sNum & "5"
            End Select
          Next
          rngTo.Offset(nRoff, nCoff) = sNum
          nCoff = nCoff + 1
          nTd = nTd + 1
        ElseIf tdtd.classname Like "po*" And Not bImg Then
          rngTo.Offset(nRoff, nCoff) = tdtd.innertext
          nCoff = nCoff + 1
          nTd = nTd + 1
        ElseIf tdtd.classname Like "ao*" Then
          nTd = nTd + 1
          rngTo.Offset(nRoff, nCoff) = tdtd.innertext
          nCoff = nCoff + 1
          bImg = False
        ElseIf tdtd.classname Like "f?r" Then
          nTd = nTd + 1
          rngTo.Offset(nRoff, nCoff) = tdtd.innertext
        ElseIf tdtd.classname Like "FA?" Then
          Select Case True
            Case InStr(tdtd.outerhtml, "1B.gif") > 0
              rngTo.Offset(nRoff, nCoff) = "1"
            Case InStr(tdtd.outerhtml, "2B.gif") > 0
              rngTo.Offset(nRoff, nCoff) = "2"
            Case InStr(tdtd.outerhtml, "12.gif") > 0
              rngTo.Offset(nRoff, nCoff) = "12"
          End Select
          nTd = nTd + 1
          nCoff = nCoff + 1
          ' nCoff =
        End If
        If nTd >= 11 Then
          nRoff = nRoff + 1
          nCoff = 2
          nTd = 1
          bImg = True
        End If
      Next tdtd
 
IEQuit:
  'Chiusura IE
  ie.Quit
  Set ie = Nothing
  Set rngTo = Nothing
End Sub



Fai sapere, grazie.
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 424
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: Importa da sito

Postdi apocrimata75 » 23/03/14 18:35

mitico, funziona perfettamente (c'era solo un refuso ma risolto subito).

Grazie mille.
Windows 7 - Office 2010
apocrimata75
Utente Senior
 
Post: 181
Iscritto il: 28/05/11 13:22


Torna a Applicazioni Office Windows


Topic correlati a "Importa da sito":

Ottimizzare sito WORDPRESS
Autore: nikita75
Forum: Discussioni
Risposte: 0
foto su sito web
Autore: sic58
Forum: Sicurezza e Privacy
Risposte: 0

Chi c’è in linea

Visitano il forum: Nessuno e 6 ospiti