Notifications
Clear all

Loteria scrape resultado site da Caixa

32 Posts
2 Usuários
0 Reactions
6,587 Visualizações
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá a todos os colegas!

é um sistema pra pegar (scrape) o resultado da Loteria Mega-Sena no site da Caixa Economica Federal (CEF).
eu consegui 2 coisas até agora:
o ModeloA pega apenas a primeira informação que aparece no site e nao puxa o resultado
o ModeloB puxa o site quase inteiro mas só em um novo arquivo.

eu gostaria de OU o ModeloA pegar os numeros do ultimo sorteio, em vez de só a primeira informação.
OU
o ModeloB salvo o novo arquivo gerado, no computador (salvar como arquivo do excel), e aí eu puxaria o resultado dele depois.

o legal desse meu sistema é que eu nao preciso dizer qual o navegador, gostaria que continuasse assim.
lembrando que voces precisar estar on-line quando testarem os sistemas e ignorarem os erros pra conferir o resultado, aí depois entrem no debug pra ver o erro.

já pesquisei muito sobre escrap e loterias e nao achei do jeito que preciso ou estavam corrompidos.
eu aceito outros modelos de scrape que nao sejam de loterias, pois posso adaptar, os links para os Site da Caixa eu já tenho.
usarei apenas este codnome de usuario agora, ele estava com problema.
abraço a todos.

 
Postado : 08/05/2015 2:26 pm
(@edcronos)
Posts: 1006
Noble Member
 

olha, eu tbm tenho meus problemas, minhas duvidas e limitações,
mas sempre tento ajudar

testando esse processo de abrir a pagina pelo excel, só posso dizer que ele é bem limitado, e somente aceita paginas tipo texto igual essa que vc colocou
se quiser eu posso te "ajudar" a implementar
falo ajudar pq como falei tbm tenho minhas limitações, e cada caso é um caso
e apesar de já ter feito algo parecido, não domino
e a memoria tbm não ajuda, então dale pesquisa :(

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 09/05/2015 3:49 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

estou usando 2modelos, 2arquivos, 2 tentativas de atingir o objetivo:
Codigo do ModeloA:
-----------------------------------------------------------------------------------
Sub ImportFromWeb()
Dim FullName As String, ImpName As String, DataRange As Variant, NumRows As Long, NumCols As Long

FullName = Range("fullname").Value

Workbooks.Open Filename:=FullName
DataRange = ActiveCell.CurrentRegion.Value
NumRows = 8
NumCols = 2
ImpName = Application.ActiveWorkbook.Name
Workbooks(ImpName).Close SaveChanges:=True

With Range("importrange")
.ClearContents
.Resize(NumRows, NumCols).Name = "importrange"
Range("importrange").Value = DataRange
End With

ActiveWorkbook.Save

End Sub

 
Postado : 09/05/2015 3:50 pm
(@edcronos)
Posts: 1006
Noble Member
 

me manda os outros link para pode fazer comparação de strutura, assim se pode fazer uma macro só para todos
não vou usar area nomeada
usar range é mais facil de trabalhar e fazer modificações futuras

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 09/05/2015 3:55 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

estou usando 2modelos, 2arquivos, 2 tentativas de atingir o objetivo:
Codigo do ModeloB:
-----------------------------------------------------------------------------------

Sub ImportFromWeb()
Dim FullName As String, ImpName As String, DataRange As Variant, NumRows As Long, NumCols As Long

FullName = Range("fullname").Value

Workbooks.Open Filename:=FullName
DataRange = ActiveCell.CurrentRegion.Value
NumRows = UBound(DataRange)
NumCols = UBound(DataRange, 2)
ImpName = Application.ActiveWorkbook.Name
Workbooks(ImpName).Close SaveChanges:=False

With Range("importrange")
.ClearContents
.Resize(NumRows, NumCols).Name = "importrange"
End With

Range("importrange").Value = DataRange

End Sub

 
Postado : 09/05/2015 3:55 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Oi Edcronos,

daqui a pouco eu envio.
abraço,
até+
----------------------------------------
edit:
aqui vai 1dos links:

" http://www.excelforum.com/excel-programming-vba-macros/945673-fetch-website-data-into-excel-using-vba-excel-macro.html"

eu fiz um arquivo, daqui a pouco eu posto.

 
Postado : 09/05/2015 3:56 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá,
tenho muitos exemplos, vou postando aos poucos analisando caso-a-caso.
esse é do "modelo Aeroporto"
Retorna o errro "Acesso Negado" no codigo original
edit: no codigo que alterei o link colocando o da Caixa Economica nao dá erro mas tambem nao faz nada.
segue o aquivo anexo e o codigo abaixo original do link do post anterior

" http://www.excelforum.com/excel-programming-vba-macros/945673-fetch-website-data-into-excel-using-vba-excel-macro.html"
------------------------------------------------------

Sub GetData()
Dim x As Long, y As Long, t As Long

Dim htm As Object

Set htm = CreateObject("htmlFile")

With CreateObject("msxml2.xmlhttp")
.Open "GET", " http://www.flightstats.com/go/FlightStatus/flightStatusByAirport.do?airport=%28EWR%29+Newark+Liberty+Intl%2C+Newark%2C+NJ%2C+US&airportQueryDate=2013-08-07&airportQueryTime=-1&airlineToFilter=&airportQueryType=0&x=50&y=6", False
.send
htm.body.innerhtml = .responsetext
End With

With htm.getElementsBytagname("table")
For t = 0 To .Length - 1
Debug.Print .Item(t).classname
If .Item(t).classname = "tableListingTable" Then
For x = 0 To .Item(t).Rows.Length - 1
For y = 0 To .Item(t).Rows(x).Cells.Length - 1
Sheets(1).Cells(x + 1, y + 1).Value = .Item(t).Rows(x).Cells(y).innertext
Next y
Next x
Exit Sub
End If
Next t
End With

End Sub
--------------------------------------------------------------------------

 
Postado : 09/05/2015 4:13 pm
(@edcronos)
Posts: 1006
Noble Member
 

olha só pensei
fiz um codigo
são os unicos comando que vc vai precisa para extrair as infirmações
é só pesquisar oq cada um faz e vc vai ter oq quer

Sub ImportFromWeb()

    Dim valn(1 To 1, 1 To 8)

  FullName = Range("fullname").Value

  Workbooks.Open Filename:=FullName

        dt = Split(Cells(10, 1).Value, "|")
        valn(1, 1) = Left(Cells(1, 1).Value, 4)
        valn(1, 2) = dt(9)
        For L = 3 To 8
            valn(1, L) = Cells(L, 1)
        Next
        ImpName = Application.ActiveWorkbook.Name
Workbooks(ImpName).Close SaveChanges:=False
Windows("MegaSena-Scrap-Forum-ModeloA-v1.xlsb").Activate
Sheets("ultimo").Range("a1:H1") = valn
    ActiveWorkbook.Save

End Sub

boa sorte

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 09/05/2015 4:36 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Obrigado, Edcronos,
te devo uma. Vou tentar te ajudar em alguma questao sua, problema que eu tenho dificuldade de entender o que os outros querem (os problemas) e os outros de me entenderem tbm.
mas vou olhando seus posts e uma hora dá certo.

sua solução funciona ok, mas atenção todos: nao pode mudar o nome do arquivo excel que o codigo para de funcionar, aí tem de mudar o nome que está dentro do codigo tambem ou voltar o nome do arquivo pro original.

o que falta fazer nesse codigo do Edcronos é definir as variaveis, coisa que até eu acertei de primeira.
abraço a todos.

 
Postado : 09/05/2015 5:17 pm
(@edcronos)
Posts: 1006
Noble Member
 

tente ajudar outros, não precisa ser a mim
mesmo coisas bem basicas vai te ajudar a aprimorar seus conhecimentos

de resto é pesquisa, teste, pesquisas, teste
mas o mais importante,
não fique atascado em ideias e conceitos alheios,
invente, aprimore,
se não der certo tente outra coisa

os link que eu falei era os link que vc ia usar para extrair as informações
os da caixa economica

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 09/05/2015 7:31 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Oi Edcronos,

sim, tenho varios links da Caixa Economica mas esse link que já estava nos arquivos do post (ModeloA e ModeloB) era o melhor porque ele retorna uma pagina leve só com as informações mais uteis.

tive um problema com o seu codigo agora na hora de pegar o resultado Mega-Sena de hoje, deu erro.
ele cria um novo arquivo excel igual no ModeloA, e nao puxa pra planilha destino.

nao sei se foi porque eu defini as variaveis de forma errada, porque no resultado anterior (anterior ao de hoje 09/05/2014) nao havia problema algum. Foi só a Caixa atualizar o resultado pra dar problema.

por gentileza confira no seu arquivo se acontece o mesmo.
o erro diz: "Erro em tempo de execução '9'. Subscrito fora do intervalo".
eu mudei todos os "8" pra "9" e continuou o mesmo problema.
----------------------------------------------------------------------
Obs: notei algo estranho no seu codigo referente aos numeros 8 e 9 dos codigos, é isso mesmo???? :
e existe um "10" também aqui: 'dt = Split(Cells(10, 1).Value, "|")'

'Dim valn(1 To 1, 1 To 8)'
'valn(1, 2) = dt(9)'
'For L = 3 To 8'

 
Postado : 09/05/2015 7:50 pm
(@edcronos)
Posts: 1006
Noble Member
 

cara como falei, vc precisa ir para o basico urgentemente
o 10 é a linha onde o codigo pega o valor
o 8 é o tamanho da array
e o 9 é a posição que está o item data depois de dividir o texto no array dt

o problema não é o meu codigo,
é na importação da pagina
se vc olhar a pagina no excel vai ver que ela não segue o padrão da anterior
aí cara o problema já é outro

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 09/05/2015 8:04 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

OBS: Dá pra pesquisar por data e por numero de concurso, são os numeros no final dos links.
eu já testei esses links e funcionam, basicamente é só trocar o final.
Links da Caixa Economica para resultados Mega-Sena e outras loterias:

" http://loterias.caixa.gov.br/wps/portal/loterias/landing/megasena/20150420.csv"

" http://loterias.caixa.gov.br/wps/portal/loterias/landing/megasena/20150420.htm"
" http://www1.caixa.gov.br/loterias/loterias/megasena/megasena_resultado.asp?jogo=1701"
" http://www1.caixa.gov.br/loterias/loterias/megasena/megasena_pesquisa_new.asp?submeteu=sim&opcao=concurso&txtConcurso=1157"
" http://www1.caixa.gov.br/rss/asp/geraXML_rss_loterias.asp?canal=MEGASENA&titulo=Mega-Sena"

" http://www1.caixa.gov.br/loterias/loterias/megasena/megasena_pesquisa_new.asp?submeteu=sim&opcao=concurso&txtConcurso=1157"

" http://loterias.caixa.gov.br/wps/portal/loterias/landing/megasena/!ut/p/a1/04_Sj9CPykssy0xPLMnMz0vMAfGjzOLNDH0MPAzcDbwMPI0sDBxNXAOMwrzCjA0sjIEKIoEKnN0dPUzMfQwMDEwsjAw8XZw8XMwtfQ0MPM2I02-AAzgaENIfrh-FqsQ9wNnUwNHfxcnSwBgIDUyhCvA5EawAjxsKckMjDDI9FQE-F4ca/dl5/d5/L2dBISEvZ0FBIS9nQSEh/"
" http://www1.caixa.gov.br/loterias/loterias/lotofacil/lotofacil_resultado.asp"
" http://www1.caixa.gov.br/loterias/loterias/ultimos_resultados.asp"

Mega-Sena - Loterias _ Caixa.htm

" http://loterias.caixa.gov.br/wps/portal/loterias/landing/megasena/20150420.csv"

" http://loterias.caixa.gov.br/wps/portal/loterias/landing/megasena/"
" http://loterias.caixa.gov.br/wps/portal/loterias/landing/megasena/resultado.htm"
" http://www1.caixa.gov.br/loterias/loterias/megasena/megasena_resultado.asp"
" http://www1.caixa.gov.br/loterias/loterias/megasena/megasena_pesquisa_new.asp"
(eu uso este ultimo link porque gera uma pagina mais limpa e leve só com os dados essenciais)

 
Postado : 09/05/2015 8:04 pm
(@edcronos)
Posts: 1006
Noble Member
 

bem vc só tem da mega
e como falei, o sistema é super limitado

use essa macro para abrir a pagina pelo excel
e vc vai ver como ela está sendo aberta,
bem diferente da anterior

Sub abreWeb()
  Workbooks.Open Filename:="http://www1.caixa.gov.br/loterias/loterias/megasena/megasena_pesquisa_new.asp"
End Sub

sinceramente, aconselho procurar outro metodo
o que eu uso funciona para todas as loteria,
só dá uns problemas estranhos com a time mania que depois de um tempo funciona legal

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 09/05/2015 8:12 pm
(@edcronos)
Posts: 1006
Noble Member
 

pode tentar com as paginas das loteria ´para celular

http://www1.caixa.gov.br/app/loterias/

vai ver que apesar da estrutura da pagina estar legal os resultados não aparecem
seria bom se funcionasse
seria muito mais simples de pegar valores

eu acho que já tentei assim, mas desistir por não funcionar
eu me confundi pelo nome que vc usou

Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

 
Postado : 09/05/2015 8:23 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Oi Edcronos!

o que vc quer dizer com Tentar outro Metodo??

vou tentar fazer o que vc sugeriu de tentar link celular e ver como a pagina é aberta.

vc conferiu o link e os exemplos do Aeroporto?
segue abaixo o anexo e o codigo vba dele.
repare no trecho: ---- 'With htm.getElementsBytagname("table")'----------

acredito que com o material que tenho vc consegue implementar
vou sim estudar "do zero" vba assim que eu puder.
segue abaixo o codigo original dele:
-----------------------------------------------------------
Sub GetData()
Dim x As Long, y As Long, t As Long

Dim htm As Object

Set htm = CreateObject("htmlFile")

With CreateObject("msxml2.xmlhttp")
.Open "GET", " http://www.flightstats.com/go/FlightStatus/flightStatusByAirport.do?airport=%28EWR%29+Newark+Liberty+Intl%2C+Newark%2C+NJ%2C+US&airportQueryDate=2013-08-07&airportQueryTime=-1&airlineToFilter=&airportQueryType=0&x=50&y=6", False
.send
htm.body.innerhtml = .responsetext
End With

With htm.getElementsBytagname("table")
For t = 0 To .Length - 1
Debug.Print .Item(t).classname
If .Item(t).classname = "tableListingTable" Then
For x = 0 To .Item(t).Rows.Length - 1
For y = 0 To .Item(t).Rows(x).Cells.Length - 1
Sheets(1).Cells(x + 1, y + 1).Value = .Item(t).Rows(x).Cells(y).innertext
Next y
Next x
Exit Sub
End If
Next t
End With

End Sub

------------------------------------------------------------------------------------

 
Postado : 09/05/2015 8:52 pm
Página 2 / 3