Skip to main content
4 de 4
Correções finais
jsantos1991
  • 2,4mil
  • 4
  • 21
  • 42

Segue o seguinte código:

Sub navega_cartola_fc()

  Dim ieApp As Object
  Dim Nome As String

  Set ieApp = New InternetExplorer

  Nome = "Botafogo"

  ieApp.navigate "http://www.scoutscartola.com/mercado"

  ieApp.Visible = True
  While ieApp.Busy: Wend

  'atualiza a pagina depois de preencher os valores dos campos a procurar
  Do While ieApp.Busy: DoEvents: Loop
  Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

  'altera o valor da combobox
  Set ieDoc = ieApp.Document
  Set ObjAaa =ieDoc.getElementById("tmercado_length").getElementsByTagName("select")(0)
  Dim evt As Object
  Set evt = ieDoc.createEvent("htmlevents")
  evt.initEvent "change", True, False

  ObjAaa.Value = 100
  'Vai selecionar este valor -> <option value="-1">1000</option>
  'Se quiseres outro valor altera consoante o valor do "value"
  ObjAaa.dispatchEvent evt

  '<<<< new update >>>>
  Set ieDoc1 = ieApp.Document
  Set ObjAaaTime = ieApp.Document.all.Item("data[filtro_time]")(0)
  Dim evt1 As Object
  Set evt1 = ieDoc.createEvent("htmlevents")
  evt1.initEvent "change", True, False

  ObjAaaTime.Value = Nome
  'Vai selecionar este valor -> <option value="botafogo">Botafogo</option>
  'Se quiseres outro valor altera consoante o valor do "value"
  'se vais fornecer este valor pelo excel deves de criar uma espécie de uma lista fixa com todos os valores possíveis
  ObjAaaTime.dispatchEvent evt1

  'volta a atualizar a página
  Do While ieApp.Busy: DoEvents: Loop
  Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

  Dim r, c As Integer
  Dim elemCol As Object

  Set elemCol = ieApp.Document.getElementsByTagName("tbody")

  Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 3)

  For r = 0 To elemCol(0).Rows.Length - 1
      For c = 0 To elemCol(0).Rows(r).Cells.Length - 1
          ActiveSheet.Cells(r + 1, c + 1) =elemCol(0).Rows(r).Cells(c).innerText
      Next c
  Next r

  ieApp.Quit

  Set elemCol = Nothing
  Set ieApp = Nothing
 
 End Sub
jsantos1991
  • 2,4mil
  • 4
  • 21
  • 42