Captura Dólar Web

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.

Ola amigo muito boa noite!

poderia disponibilizar o projeto para melhor ajuda-lo ?

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

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!

Olá amigo, sabe me dizer qual erro:

veja aqui funcionou.



segue projeto novamente.

Danilo,

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

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.

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.





abraços

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.

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

Rodrigo

Pode postar o exemplo .
Obrigado e Bom Ano

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.

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

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.

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

Obrigado Amigo Teixeira

Bom Ano

Segue link.

dolar_web2 - revisado

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