Baixar Resultados Da Lotofacil Via Vba

[Nanilinho]

Boa Tarde

 

Gostaria de ajuda sobre baixar resultados da lotofacil em uma aba chamada resultados. Como que faz via VBA?

 

Grato pela ajuda

 

 

 

[Guest Zangado]

o

Pitaco_certo! postou o codigo de uma macro que ele fez em um post meu

http://www.comoganharnaloteria.com.br/forum/topico/25823-planilha-loto-facil-projeto-macros-excel-2010/

 

ve se dá para adaptar

o processo que eu uso é pelo site e apesar de achar que é mais simples que o dele, o dele é mais rapido

[Nanilinho]

Boa Tarde

 

Vou verificar.. estou trabalhando numa planilha para análises e gostaria de baixar os resultados de forma automática para evitar erros de digitação

 

Obrigado pela dica

[eduardodp]

BAIXAR O ARQUIVO ZIP

 

i:\ = PEN DRIVE

 

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _

    (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _

    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

 

 

Private Sub CommandButton1_Click()

    On Error GoTo Err

    Dim Auxiliar As Long

    Dim URL As String

    Dim CaminhoLocal As String

    Dim x

    For x = 1 To 8

        If x = 1 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_lotfac.zip"

            CaminhoLocal = "i:\d_lotfac.zip"

        ElseIf x = 2 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_lotoma.zip"

            CaminhoLocal = "i:\D_lotoma.zip"

        ElseIf x = 3 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/d_loteca.zip"

            CaminhoLocal = "i:\d_loteca.zip"

        ElseIf x = 4 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/d_lotogo.zip"

            CaminhoLocal = "i:\d_lotogo.zip"

        ElseIf x = 5 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_megase.zip"

            CaminhoLocal = "i:\D_megase.zip"

        ElseIf x = 6 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_quina.zip"

            CaminhoLocal = "i:\D_quina.zip"

        ElseIf x = 7 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/d_dplsen.zip"

            CaminhoLocal = "i:\d_dplsen.zip"

        ElseIf x = 8 Then

            URL = "http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_timema.zip"

            CaminhoLocal = "i:\D_timema.zip"

        End If

        Auxiliar = URLDownloadToFile(0, URL, CaminhoLocal, 0, 0)

    Next

    MsgBox "Download efetuado com sucesso!"

    Exit Sub

Err:

    MsgBox "Erro no download do arquivo"

End Sub

Edited April 15, 2015 by eduardodp

[eduardodp]

DESCOMPACTAÇÃO DOS ARQUIVOS

 

i:\ = PEN DRIVE

 

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _

    (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _

    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

 

Private Sub CommandButton1_Click()

    Dim oApp As Object 'Objeto application

    Dim Arquivo As Variant

    Dim NovaPasta As Variant

    Dim Caminho As String

    Dim strDate As String

    Dim x

    Caminho = "i:\"

    strDate = Format(Now, "dd-mm-yy h-mm-ss")

    NovaPasta = Caminho & "LOTERIAS DA CAIXA " & strDate & "\"

    MkDir NovaPasta

    For x = 1 To 8

        If x = 1 Then

            Arquivo = caminho & "D_lotfac.zip"

        ElseIf x = 2 Then

            Arquivo = caminho & "D_lotoma.zip"

        ElseIf x = 3 Then

            Arquivo = caminho & "D_loteca.zip"

        ElseIf x = 4 Then

            Arquivo = caminho & "D_lotogo.zip"

        ElseIf x = 5 Then

            Arquivo = caminho & "D_megase.zip"

        ElseIf x = 6 Then

            Arquivo = caminho & "D_quina.zip"

        ElseIf x = 7 Then

            Arquivo = caminho & "D_dplsen.zip"

        ElseIf x = 8 Then

            Arquivo = caminho & "D_timema.zip"

        End If

        Set oApp = CreateObject("Shell.Application")

        oApp.Namespace(NovaPasta).CopyHere oApp.Namespace(Arquivo).items

    Next

End Sub

Edited April 16, 2015 by eduardodp

[Nanilinho]

Bom dia

 

Precisava que além de baixasse, ele atualizasse a minha planilha tipo com numero do sorteio, data e dezenas.

 

Grato