MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


+4
RodrigoMalagodi
Avelino Sampaio
daniloreiis
msantolli
8 participantes

    Captura Dólar Web

    avatar
    msantolli
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 15
    Registrado : 02/07/2012

    Captura Dólar Web Empty Captura Dólar Web

    Mensagem  msantolli 26/1/2015, 05:04

    Senhores,

    Estou tentando adaptar o exemplo do profº Avelino Sampaio (http://www.usandoaccess.com.br/dicas/capturando-data-e-hora-da-internet.asp), para capturar a Cotação do PTAX no site www.bcb.gov.br, já fiz várias tentativas sem sucesso, até consigo capturar valores de outros sites, se estes valores estiverem em tabelas. Neste caso aqui, teria que usar o comando InnerText. Ajudem-me por favor.
    daniloreiis
    daniloreiis
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 338
    Registrado : 14/02/2011

    Captura Dólar Web Empty Captura Dólar Web

    Mensagem  daniloreiis 26/1/2015, 23:51

    Ola amigo muito boa noite!

    poderia disponibilizar o projeto para melhor ajuda-lo ?


    .................................................................................
    Att, Danilo Reis
    -------------------------------------------------------------------------------------------------------------------------------------------------

    Se alguém não quiser trabalhar, não coma também.
    2 Tessalonicenses 3:10
    Avelino Sampaio
    Avelino Sampaio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3900
    Registrado : 04/04/2010

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  Avelino Sampaio 27/1/2015, 08:54

    Olá!

    Passe o intPos para LONG:

    Dim intPos As Long

    Passe o Document.All() para 1:

    PaginaHtml = objIE.Document.All(1).InnerHTML


    Use o "(ptax)" como referência:

    intPos = InStr(PaginaHtml, "(PTAX)") - 6 'aqui vc pegue a posição da data em diante

    Aguardamos


    .................................................................................
    Vídeos, livros, kit MontaRibbons e acesso vitalício ao site UsandoAcces  
    Clique AQUI e analise o custo beneficio do material oferecido.
    daniloreiis
    daniloreiis
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 338
    Registrado : 14/02/2011

    Captura Dólar Web Empty Captura Dólar Web

    Mensagem  daniloreiis 27/1/2015, 12:43

    Olá meu amigo msantolli!

    deu trabalho mas acredito que deu resultado,

    graças ao Mestre Avelino, modifiquei o projeto "(http://www.usandoaccess.com.br/dicas/capturando-data-e-hora-da-internet.asp"

    busquei os valores do site "www.bcb.gov.br"

    e cheguei no resultado do dolar compra e venda.

    segue projeto.

    abraços
    Anexos
    Captura Dólar Web Attachmentdolar_web.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (23 Kb) Baixado 93 vez(es)


    .................................................................................
    Att, Danilo Reis
    -------------------------------------------------------------------------------------------------------------------------------------------------

    Se alguém não quiser trabalhar, não coma também.
    2 Tessalonicenses 3:10
    avatar
    msantolli
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 15
    Registrado : 02/07/2012

    Captura Dólar Web Empty Captura Dólar Web

    Mensagem  msantolli 28/1/2015, 17:44

    Aos amigos Danilo e Avelino meu muito obrigado pela atenção sempre dispensada aos iniciantes aqui do fórum.

    Danilo, fiz download do seu exemplo e não funcionou, vou ver se consigo achar o erro.

    Grande abraço!
    daniloreiis
    daniloreiis
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 338
    Registrado : 14/02/2011

    Captura Dólar Web Empty Captura Dólar Web

    Mensagem  daniloreiis 28/1/2015, 18:19

    Olá amigo, sabe me dizer qual erro:

    veja aqui funcionou.

    Captura Dólar Web 156ej5l

    segue projeto novamente.
    Anexos
    Captura Dólar Web Attachmentdolar_web2.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (27 Kb) Baixado 67 vez(es)


    .................................................................................
    Att, Danilo Reis
    -------------------------------------------------------------------------------------------------------------------------------------------------

    Se alguém não quiser trabalhar, não coma também.
    2 Tessalonicenses 3:10
    avatar
    msantolli
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 15
    Registrado : 02/07/2012

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  msantolli 28/1/2015, 18:59

    Danilo,

    Infelizmente nada acontece. O código termina e fica tudo em branco!
    avatar
    msantolli
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 15
    Registrado : 02/07/2012

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  msantolli 11/2/2015, 10:46

    Bom dia, pessoal!

    Alguém mais poderia dar uma força aqui? O código do Danilo está aparentemente certo, porque será que não funciona aqui pra mim? já tentei de tudo. É tão chato ter que atualizar manualmente esses valores todos os dias.
    daniloreiis
    daniloreiis
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 338
    Registrado : 14/02/2011

    Captura Dólar Web Empty Captura Dólar Web

    Mensagem  daniloreiis 11/2/2015, 11:27

    Olá meu amigo muito bom dia !

    poderia me dizer ou ate mesmo postar aqui qual erro esta dando para você?

    para que eu possa ajudar melhor?

    acabei de rodar aquela modelo que eu postei e ja me deu o valor atualizado de 2,8069.

    Captura Dólar Web 20pabcw

    Captura Dólar Web 2mnk8q9

    abraços


    .................................................................................
    Att, Danilo Reis
    -------------------------------------------------------------------------------------------------------------------------------------------------

    Se alguém não quiser trabalhar, não coma também.
    2 Tessalonicenses 3:10
    avatar
    RodrigoMalagodi
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 8
    Registrado : 09/05/2013

    Captura Dólar Web Empty Cotação Dólar

    Mensagem  RodrigoMalagodi 30/12/2015, 00:22

    Caros, no meu também não aparece nada, além dos valores et=win no campo Compra e " cont no campo Venda.

    Dei uma olhada no código e vi que a linha abaixo o link dá erro.

    objIE.Navigate "https://www3.bcb.gov.br/ptax_internet/consultarUltimaCotacaoDolar.do"

    Dei uma pesquisada no site do BCB e achei essa página abaixo, a qual mostrou a mesma informação, porém, no formulário do Access não mostra os valores.

    objIE.Navigate "http://www4.bcb.gov.br/pec/taxas/batch/taxas.asp?id=txdolar"

    O que preciso saber é se é preciso habilitar algum recurso e/ou suplemento no programa para que a função execute e traga os valores nos respectivos campos.

    Um abraço e Deus os abençoe.
    avatar
    RodrigoMalagodi
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 8
    Registrado : 09/05/2013

    Captura Dólar Web Empty Cotação Dólar

    Mensagem  RodrigoMalagodi 30/12/2015, 01:17

    Galera, consegui fazer o sistema buscar os valores com o código abaixo.

    Option Compare Database
    Private Sub btCapturar2_Click()
    fncCapturaDataHora2
    'PTAX_COMPRA = ""
    'PTAX_VENDA = ""
    End Sub


    Function fncCapturaDataHora2() As Date
    Dim objIE As Object
    Dim intPos As Integer
    Dim PaginaHtml As String
    Dim ptax_venda_web As String
    'Dim ptax_compra_web As String
    On Error GoTo trataErro
    '----------------------------------------------------------
    'Verifica se o site está ativo
    'caso não esteja ativo, função assume valor falso de data
    '----------------------------------------------------------
    If Not fncSiteAtivo("www.dolarhoje.com.br") Then
    fncCapturaDataHora2 = "0,00"
    Exit Function
    End If
    '-----------------------------------------------
    'Abre o Internet Explorer
    '-----------------------------------------------
    Set objIE = CreateObject("InternetExplorer.Application")
    '--------------------------------------
    'Esconde o navegador Internet Explorer
    '--------------------------------------
    objIE.Visible = False
    '--------------------------------------------------
    'Carrega a página do Observatório Nacional
    '---------------------------------------------------
    objIE.Navigate "https://ptax.bcb.gov.br/ptax_internet/consultarUltimaCotacaoDolar.do"
    '------------------------------------------------
    'Aguarda até o completo carregamento da página
    '------------------------------------------------
    Do While objIE.Busy: DoEvents: Loop
    Do While objIE.ReadyState <> 4: DoEvents: Loop
    '------------------------------------------------------
    'Passa todo o código HTML para a variável PaginaHtml
    '------------------------------------------------------
    PaginaHtml = objIE.Document.All(0).InnerHTML
    '--------------------------------------------------------------------
    'Encontra a posição da frase "Hora Oficial de Brasilia" no texto HTML
    '---------------------------------------------------------------------
    intPos = InStr(PaginaHtml, "CENTER") + 66

    '-------------------------------------------
    'passa para a função o valor da data e hora
    '-------------------------------------------

    'popula valor dolar compra
    PTAX_COMPRA = Replace(Replace(Mid(PaginaHtml, intPos, 7), "'ptax_compra_web = Mid(ptax_compra_web, 52, 6)
    'PTAX_COMPRA = ptax_compra_web
    'tratamento capturar dolar venda
    ptax_venda_web = Replace(Replace(Mid(PaginaHtml, intPos, 60), "ptax_venda_web = Mid(ptax_venda_web, 52, 6)
    'popupa valor dolar venda
    PTAX_VENDA = ptax_venda_web

    sair:
    '-----------------------------
    'Encerra o Internet Explorer
    '-----------------------------
    objIE.Quit
    Set objIE = Nothing
    Exit Function

    trataErro:
    fncCapturaDataHora2 = #1/1/1800#
    Resume sair
    End Function


    Private Function fncSiteAtivo(ByVal NomeSite As String) As Boolean
    Dim colPingResults As Object
    Dim oPingResult As Variant
    Dim strQuery As String
    strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & NomeSite & "'"
    Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
    For Each oPingResult In colPingResults
    If Not IsObject(oPingResult) Then
       fncSiteAtivo = False
    ElseIf oPingResult.StatusCode = 0 Then
    fncSiteAtivo = True
    Else
    fncSiteAtivo = False
    End If
    Next
    Set colPingResults = Nothing
    End Function
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4772
    Registrado : 06/11/2009

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  Assis 30/12/2015, 11:07

    Rodrigo

    Pode postar o exemplo .
    Obrigado e Bom Ano


    .................................................................................
    *** Só sei que nada sei ***
    avatar
    RodrigoMalagodi
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 8
    Registrado : 09/05/2013

    Captura Dólar Web Empty Cotação Dólar

    Mensagem  RodrigoMalagodi 30/12/2015, 13:00

    Bom dia Assis, posso sim cara!

    Dei uma adaptada à minha necessidade.Veja no exemplo que coloquei o formulário para atualizar os valores ao carregar, mas também tem a opção de atualizar clicando no botão.

    Não consegui enviar o arquivo em anexo, mas segue link do 4shared.com. para download.

    Link direto - dólar_web2

    Veja aí o código e também o anexo!

    ========================================Option Compare Database
    Private Sub btCapturar2_Click()
    fncCapturaDataHora2
    'PTAX_COMPRA = ""
    'PTAX_VENDA = ""
    End Sub


    Function fncCapturaDataHora2() As Date
    Dim objIE As Object
    Dim intPos As Integer
    Dim PaginaHtml As String
    Dim ptax_venda_web As String
    'Dim ptax_compra_web As String
    On Error GoTo trataErro
    '----------------------------------------------------------
    'Verifica se o site está ativo
    'caso não esteja ativo, função assume valor falso de data
    '----------------------------------------------------------
    If Not fncSiteAtivo("www.dolarhoje.com.br") Then
       fncCapturaDataHora2 = "0,00"
       Exit Function
    End If
    '-----------------------------------------------
    'Abre o Internet Explorer
    '-----------------------------------------------
    Set objIE = CreateObject("InternetExplorer.Application")
    '--------------------------------------
    'Esconde o navegador Internet Explorer
    '--------------------------------------
    objIE.Visible = False
    '--------------------------------------------------
    'Carrega a página do Observatório Nacional
    '---------------------------------------------------
    objIE.Navigate "https://ptax.bcb.gov.br/ptax_internet/consultarUltimaCotacaoDolar.do"
    '------------------------------------------------
    'Aguarda até o completo carregamento da página
    '------------------------------------------------
    Do While objIE.Busy: DoEvents: Loop
    Do While objIE.ReadyState <> 4: DoEvents: Loop
    '------------------------------------------------------
    'Passa todo o código HTML para a variável PaginaHtml
    '------------------------------------------------------
    PaginaHtml = objIE.Document.All(0).InnerHTML
    '--------------------------------------------------------------------
    'Encontra a posição da frase "Hora Oficial de Brasilia" no texto HTML
    '---------------------------------------------------------------------
    intPos = InStr(PaginaHtml, "CENTER") + 66

    '-------------------------------------------
    'passa para a função o valor da data e hora
    '-------------------------------------------

    'popula valor dolar compra
    PTAX_COMPRA = "R$ " & Replace(Replace(Mid(PaginaHtml, intPos, 7), "'ptax_compra_web = Mid(ptax_compra_web, 52, 6)
    'PTAX_COMPRA = ptax_compra_web
    'tratamento capturar dolar venda
    ptax_venda_web = Replace(Replace(Mid(PaginaHtml, intPos, 60), "ptax_venda_web = Mid(ptax_venda_web, 52, 6)
    'popupa valor dolar venda
    PTAX_VENDA = "R$ " & ptax_venda_web

    sair:
    '-----------------------------
    'Encerra o Internet Explorer
    '-----------------------------
    objIE.Quit
    Set objIE = Nothing
    Exit Function

    trataErro:
       fncCapturaDataHora2 = #1/1/1800#
       Resume sair
    End Function


    Private Function fncSiteAtivo(ByVal NomeSite As String) As Boolean
    Dim colPingResults As Object
    Dim oPingResult As Variant
    Dim strQuery As String
    strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & NomeSite & "'"
    Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
    For Each oPingResult In colPingResults
       If Not IsObject(oPingResult) Then
           fncSiteAtivo = False
       ElseIf oPingResult.StatusCode = 0 Then
           fncSiteAtivo = True
       Else
           fncSiteAtivo = False
       End If
    Next
    Set colPingResults = Nothing
    End Function


    Private Sub Form_Load()
    fncCapturaDataHora2
    End Sub

    =================

    Espero que ajude a quem precisar.

    Feliz Ano Novo a todos e que Deus os abençoe.
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4772
    Registrado : 06/11/2009

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  Assis 30/12/2015, 15:01

    Obrigado Rodrigo pelo link mas não gosto muito desse site.

    Se colocar neste agradeço, é só arrastar para lá o exemplo e copiar o link e colar aqui no forum

    http://ge.tt/

    Obrigado

    santa santa santa



    .................................................................................
    *** Só sei que nada sei ***
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5120
    Registrado : 20/04/2011

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  Silvio 30/12/2015, 16:21

    Tardesssss

    O tempo de espera no 4Shared era de 20 segundos para o download. Hoje, está em 1.000 segundos.
    Eu usei ele, por muito tempo, mas......sou mais o ge.tt ou o google drive.

    Fica aqui a dica.
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7996
    Registrado : 15/03/2013

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  Alvaro Teixeira 30/12/2015, 16:52

    Olá a todos.
    O fórum já permite anexar.
    Abraço e Bom Ano 2016
    Assis
    Assis
    Maximo VIP
    Maximo VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 4772
    Registrado : 06/11/2009

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  Assis 30/12/2015, 16:55

    Obrigado Amigo Teixeira

    Bom Ano


    .................................................................................
    *** Só sei que nada sei ***
    avatar
    RodrigoMalagodi
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 8
    Registrado : 09/05/2013

    Captura Dólar Web Empty Captura Dólar Web

    Mensagem  RodrigoMalagodi 30/12/2015, 17:30

    Segue link.

    dolar_web2 - revisado
    avatar
    ifahidalgo
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 381
    Registrado : 13/10/2011

    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  ifahidalgo 9/6/2020, 19:47

    Senhores, super gostei desse codigo, mas também preciso da cotação do Euro, e não acho um oficial que adapte no codigo.

    Conteúdo patrocinado


    Captura Dólar Web Empty Re: Captura Dólar Web

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 21/11/2024, 20:51