Olá pessoal!

Esta rotina captura a página do
BC (Banco Central), onde fica a cotação do dólar do
dia anterior ao corrente e filtra somente os dados que
interessam.

Podem ser feitas outras customizações
onde os valores capturados são colocados num BD, etc…

Aproveitem o máximo da rotina,
mas por favor, mantenham os créditos.

<%
‘
Função para a captura do dólar comercial diretamente
do site do Banco Central.
‘ Autor : Adriano Dias
‘ E-mail : adiasbr@yahoo.com.br
‘ Data : 03/Ago/2001
‘ Use, altere, melhore a vontade,
mas por favor, não esqueça os créditos.

Response.Expires = 0
Session.LCID = 1046

Err.Clear
On Error Resume Next

Set obj = CreateObject("MSXML2.ServerXMLHTTP")
obj.open "GET", "http://www.bcb.gov.br/htms/infecon/taxas/taxas.htm"
obj.send
textHTML = obj.ResponseText
dados = LCase(textHTML)

‘ Procura pela posição da string "Taxa de Venda"
i = 1
i = inStr(i,dados,"taxa de venda")

‘ Procura pela 1ª tag depois de "Taxa
de Venda"
i = inStr(i,dados," f = inStr(i,dados," 1ª tag depois de
dados = Mid(dados,i,(f-i)) ‘ Retira somente linha
da interesse

dados = Replace(dados,"","|",1,2)
‘ Substitui por "|" (2 vezes)
dados = Trim(LimpaHTML(dados)) ‘ Retira
todas as tags
dados = Split(dados,"|") ‘
Separa criando a matriz

dat = DateAdd("d",-1,Date)
‘ Data Base (Hoje – 1 dia). A Cotação é sempre do dia
anterior

set conn = Server.CreateObject("ADODB.Connection")
conn.open Application("conn")

‘ Verifica se os dados parecem válidos
if not isDate(dados(0)) or not isNumeric(dados(1)) or
not isNumeric(dados(2))
then
msgerro = "Provavel problema com os dados
capturados. " & vbcrlf & _
"Data Base (" & ConverteData(dat,"DD/MM/YYYY")
& ") " & vbcrlf & _
"Dados Recebidos (Data: " &
dados(0) & ",Compra: " & dados(1)
&
",Venda: " & dados(2) & ")"
Finaliza
end if

‘ Verifica se a data recebida parece válida (considerado
no max. 4 dias desatulizado. Ex. Carnaval : (Sáb, Dom,
Seg, Ter)
if (DateDiff("d",CDate(dados(0)),dat) >
4) or (DateDiff("d",CDate(dados(0)),dat) <
0) then
msgerro = "Datas de captura e data base
muito distantes. " & vbcrlf & _
"(Capturada)/(Base) : (" &
dados(0) & ")/(" & dat & ")"
Finaliza
end if

‘ Se houve uma falha não maior que 4 dias e o dia
não é final de semana, atualiza com a ultima data e
avisa o admin.
if (not WeekDay(dat) = 1) and (not WeekDay(dat) = 7)
and (CDate(dados(0)) <> dat) then
msgerro = "Data de atualização diferente
da data esperada. Trata-se de um feriado ? " &
vbcrlf & _
"Os dados foram incluídos, porém certifique
se está correto. Datas : (Recebida)/(Base) (" &
dados(0) & ")/(" & dat & ")"
end if

‘ Mostra os dados capturados
inf = Array("Data","Compra","Venda")
For i = lbound(dados) to ubound(dados)
Response.Write inf(i) & " : "
& dados(i) & "
"
Next

Finaliza
‘ Final da rotina

‘ Sub´s e Function´s

Sub Finaliza
if Len(msgerro) <> 0 then ‘ Se existe
uma mensagem de erro…

‘ Envia e-mail
para o Administrador
Set ObjMail = CreateObject("CDONTS.NewMail")
objMail.Send "sender@dominio", "admin@dominio",
"Problemas com
atualizacao da cotacao do dolar", msgerro
Set ObjMail = nothing
Response.Write "Erro na captura…"
end if
if Err.Number <> 0 then ‘ Se Err.Number contiver
algo…

‘ Envia e-mail
para o Administrador
msgerro = "Erro Desconhecido. Cód. Erro :
" & Err.Number & " (" &
Err.Description & ")" & vbcrlf &
_
"Conteúdo da página de Erro :
" & vbcrlf & vbcrlf & LimpaHTML(Replace(textHTML,"
",vbcrlf))
Set ObjMail = CreateObject("CDONTS.NewMail")
objMail.Send "sender@dominio", "admin@dominio",
"Problemas com atualizacao da cotacao do dolar",
msgerro
Set ObjMail = nothing
Response.Write "Erro na captura…"
end if
conn.close
set conn = nothing
Response.End
End Sub

Function Strzero(val,num)
val = Trim(CStr(val))
Strzero = String(num-len(val),"0") &
val
End Function

Function ConverteData (valor,formato)
if not isDate(valor) then
Response.Write "Data Inválida !"
Response.End
else
formato = UCase(formato)
if Trim(formato) = "" then formato = "DD/MM/YYYY
HH:MI:SS"
formato = Replace(formato,"YYYY",Year(valor))
formato = Replace(formato,"MM",Strzero(Month(valor),2))
formato = Replace(formato,"DD",Strzero(Day(valor),2))
formato = Replace(formato,"HH",Strzero(Hour(valor),2))
formato = Replace(formato,"MI",Strzero(Minute(valor),2))
ConverteData = Replace(formato,"SS",Strzero(Second(valor),2))
end if
End Function

Function LimpaHTML(matriz)
Do While True
ini = InStr(1,matriz,"<")
If ini = 0 Then Exit Do
fim = InStr(ini,matriz,">")
parcial = Mid(matriz,ini,fim-ini+1)
matriz = Replace(matriz,parcial,"")
Loop
LimpaHTML = matriz
End Function
%>