Cálculo Online Encomendas Correios

Acabo de criar, bom proveito

<%
Option Explicit
Sub calcularFreteCorreios(servico, cepOrigem, cepDestino, peso, valorDeclarado, maoPropria, avisoRecebimento, ByRef valor, ByRef uf, ByRef localidade, ByRef tarifa)
'SEDEX = 40010
'SEDEX à Cobrar = 40045
'SEDEX 10 = 40215
'PAC = 41017
If Not IsNumeric(servico) Then

 Select Case Ucase(servico)
 Case "SEDEX" : servico = "40010"
 Case "SEDEX10" : servico = "40215"
 Case "SEDEXCOBRAR": servico = "40045"
 Case "PAC" :	servico = "41017"
 Case Else
 Response.Write _
 "É necessário definir o serviço."
 Response.End()
 End Select
	End If

	cepOrigem = Replace(cepOrigem & "", "-", "")
	cepOrigem = Replace(cepOrigem, "/", "")
	cepOrigem = Replace(cepOrigem, ".", "")

	cepDestino = Replace(cepDestino & "", "-", "")
	cepDestino = Replace(cepDestino, "/", "")
	cepDestino = Replace(cepDestino, ".", "")

	If Not IsNumeric(cepOrigem) Or Len(cepOrigem) < 8 Then
 Response.Write _
 "CEP de origem não é válido."
 Response.End()
	End If

	If Not IsNumeric(cepDestino) Or Len(cepDestino) < 8 Then
 Response.Write _
 "CEP de destino não é válido."
 Response.End()
	End If

	valorDeclarado = Replace(valorDeclarado & "", ".", "")
	If Not IsNumeric(valorDeclarado) Then
 Response.Write _
 "Valor declarado é inválido."
 Response.End()
	End If

	peso = Replace(peso & "", ".", "")
	peso = Replace(peso & "", ",", ".")
	If Not IsNumeric(peso) Then
 Response.Write _
 "Peso é inválido."
 Response.End()
	End If

	maoPropria = UCase(maoPropria & "")
	If maoPropria <> "N" And maoPropria <> "S" Then
 Response.Write _
 "Mão Própria inválida."
 Response.End()
	End If

	avisoRecebimento = UCase(avisoRecebimento & "")
	If avisoRecebimento <> "N" And avisoRecebimento <> "S" Then
 Response.Write _
 "Aviso de Recebimento inválido."
 Response.End()
	End If

	Dim urlCorreios
	Dim XMLHttp
	Dim objXML
	Dim resposta
	DIM objErro
	Dim objPreco
	Dim objLocal
	Dim objTarifa

	urlCorreios = ""&_
 "[http://www.correios.com.br/encomendas/precos/calculo.cfm?"&_](http://www.correios.com.br/encomendas/precos/calculo.cfm?)
 "resposta=xml&"&_
 "servico=" & servico & "&"& _
 "cepOrigem=" & cepOrigem & "&"&_
 "cepDestino=" & cepDestino & "&"&_
 "peso=" & peso & "&"&_
 "MaoPropria=" & maoPropria & "&"&_
 "valorDeclarado=" & valorDeclarado & "&"&_
 "avisoRecebimento=" & avisoRecebimento & ""
	Set XMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
	XMLHttp.setOption 2, 13056
	XMLHttp.Open "POST", urlCorreios, False
	XMLHttp.send()
	Set objXML = Server.CreateObject("Microsoft.XMLDOM")
	objXML.async = True
	objXML.load(XMLHttp.responseBody)
	If CStr(objXML.parseError.errorCode) <> "0" Then
 valor = -1
	Else
 Set objErro = objXML.getElementsByTagName("erro")
 If CStr(objErro.item(0).text <> "0") Then
 valor = -1
 Else
 Set objPreco	= objXML.getElementsByTagName("preco_postal")
 valor = objPreco.item(0).text
 Set objLocal	= objXML.getElementsByTagName("uf_destino")
 uf = objLocal.item(0).text
 Set objLocal	= objXML.getElementsByTagName("local_destino")
 localidade = objLocal.item(0).text
 Set objTarifa	= objXML.getElementsByTagName("tarifa_valor_declarado")
 tarifa = objTarifa.item(0).text
 Set objTarifa = Nothing
 Set objPreco = Nothing
 Set objLocal = Nothing
 End If
 Set objErro = Nothing
	End If
	Set XMLHttp = Nothing
	Set objXML = Nothing

End Sub

Dim valor
Dim uf
Dim localidade
Dim tarifa

Call calcularFreteCorreios ("PAC", "91910530", "91910530", "3", "10", "N", "N", valor, uf, localidade, tarifa)

response.Write "Valor Tarifa Seguro: R$ " & tarifa & "<br />"
response.Write "Valor Encomenda: R$ " & valor & "<br />"

response.Write "UF/Localidade: " & uf & "/" & localidade %>