consulta web automática desde excel

Ja, me hicieron "laburar" con esta inquietud... pero bueno, es sábado y tengo tiempo para desarrollarla tranquilo y así ayudar a mi lector. Tema: mi amigo, todos los días, ingresa a una página web para ver la cotización del dolar y el euro, anotando en una planilla de cálculos lo que allí visualiza. Necesita llevar un registro histórico de dichas cotizaciones, por cuestiones laborales y de inversiones propias. Me pregunta ¿Puede Excel realizar automáticamente este trabajo? Le respondo: Si, puede. Con macros y autoformas llevaremos esto:

a esto:

[+/-] Ver el resto / Ocultar

Con la ventaja de que:

1) Excel volcará desde la web la cotización del día.

2) Si el separador decimal no coincide (algo común cuando traemos datos Html) lo cambiará

3) Volcará la cotización a una tabla

4) Eliminará los duplicados, por que el registro debe ser diario (una cotización x día)

5) Colocará ciertos valores en las celdas, para que las autoformas y el wordart insertos en la planilla reflejen esos datos, y así darle un mejor aspecto, como se ve en la imagen superior.

6) El usuario final no interviene para nada, todas las acciones se llevan a cabo luego de producirse el evento "Open" del libro (Workbook).

¿Empezamos?

En esta entrada aprendimos a importar datos desde la Web, en una serie de pasos sencillos. Seleccionamos una tabla de la página web y con el botón "importar" la llevamos a un rango de Excel. Para el proyecto que desarrollaremos utilicé la página http://www.cotizacion-dolar.com.ar, la cual tiene este dato que me interesa:

El código VBA para traerla es el siguiente:

Sub ImportarCotizacion()
Dim UrlWeb As String

On Error GoTo Salida
'almaceno la url desde donde obtendré la tabla:
UrlWeb = "http://www.cotizacion-dolar.com.ar"
'agrego una hoja, la cual posteriormente eliminaré
Sheets.Add
    'y ejecuto la consulta web:
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & UrlWeb, Destination:=Range("$A$1"))
        .Name = UrlWeb
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Salida:
    'si se produjo algún error aviso:
    If Err.Number <> 0 Then
        MsgBox "Se produjeron problemas, verifique su " _
        & "conexión a Internet", vbCritical, "Cotización"
        End
    End If
End Sub

Lo que nos arroja el siguiente resultado:

sin formatos ni nada por el estilo: solo datos, que son los que me interesan.

Ahora a esos datos tengo que llevarlos a una tabla, para ir registrando las cotizaciones día a día. Aquí se puede observar el problema del separador decimal, que dependerá de la configuración regional de cada PC. Para evitar inconvenientes y transportar valores numéricos a la tabla, dentro del código observarán que utilizo a Replace() para cambiar el punto por la coma:

Sub LlevarDatosATabla()
Dim Fecha As Date
Dim Fila As Long

'tomo la fecha actual, para agregarla a la tabla de
'datos:
Fecha = Date
On Error Resume Next
'aqui reemplazo el separador decimal, si es
'necesario (el punto por la coma):
If Application.DecimalSeparator = "," Then
    Range("b3:c5").Replace ".", ","
End If
'y finalmente coloco cada cotización (+ la fecha actual)
'en la una tabla ubicada en la hoja "cotiza"
With Sheets("cotiza")
    'determino la ultima fila ocupada de la tabla
    Fila = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
    Fila = Fila + 1
    'coloco los datos de la importación en la tabla:
    .Cells(Fila, "A") = Fecha
    .Cells(Fila, "B") = CDbl(Cells(3, "B"))
    .Cells(Fila, "C") = CDbl(Cells(3, "C"))
    .Cells(Fila, "D") = CDbl(Cells(5, "B"))
    .Cells(Fila, "E") = CDbl(Cells(5, "C"))
End With
End Sub

Lo que nos lleva a la tabla visualizada en la segunda imagen de este post:

El trabajo ya estaría finalizado: leímos una tabla de la web, trajimos sus datos a Excel, adaptamos su separador decimal y los llevamos a nuestra propia tabla, agregando la fecha de la migración.

Pero vamos por un poco mas. Colocaremos un par de "carteles", confeccionados con autoformas y wordart, para darle un mejor diseño (y mas llamativo) a nuestra planilla. 

Si coloco una "shape", la selecciono y (por ejemplo) en la barra de fórmulas agrego: =E1, esa autoforma reflerá el valor de la mencionada celda, con la gran ventaja de tener luego a nuestro alcance una enorme cantidad de herramientas para trabajar el formato y lograr efectos de primer nivel:

ni punto de comparación. En la autoforma estamos colocando el valor que se encuentre en E1, pero logrando un diseño fuera de lo común.

Si aplicamos esto al proyecto que estamos tratando, usaremos unas celdas auxiliares para colocar "datos en crudo", los que luego incluiremos en las shapes y wordart. Pondré cierto texto en las celdas A1, B1 y C1. La finalidad de esto es contar con los valores de la última cotización del dolar/euro (fecha e importes) dentro de una autoforma, con lo cual me veo en la necesidad de almacenar la última fila de la tabla:

Sub Cartelera()
Dim Fila As Long

Fila = Cells(Cells.Rows.Count, 1).End(xlUp).Row

'coloco en las celdas las ultimas cotizaciones, junto a
'la fecha de donde las extraigo:
Range("a1") = "Dolar: Compra " & Cells(Fila, "B") _
& " / Venta " & Cells(Fila, "C")

Range("b1") = "Euro: Compra " & Cells(Fila, "D") _
& " / Venta " & Cells(Fila, "E")

Range("c1") = "Día: " & Cells(Fila, "A")
End Sub

Mi lector lleva un registro diario, o sea que solo debo almacenar una cotización por día. Aprovecharé las nuevas herramientas de Excel 2010 para quitar los duplicados mediante una macro:

Sub QuitarDuplicados()
Dim Fila As Long

'me voy a la hoja con las cotizaciones
Sheets("cotiza").Select
'guardo la ultima celda ocupada
Fila = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
    'y elimino los dias duplicados:
    Range("A3").Select
    ActiveSheet.Range("$A$3:$E$" & Fila).RemoveDuplicates Columns:=1, Header:=xlYes
Application.DisplayAlerts = True
End Sub

Y terminamos. El trabajo realizado nos asegura la automatización total del proceso, mas algunos pequeños trucos para mejorar el resultado del informe final:

Podemos crear el Sub Iniciar() y colocar allí dentro las llamadas a los procedimientos arriba descriptos, para modularizar un poco todo esto:

Sub Iniciar()
    ImportarCotizacion
    LlevarDatosATabla
    EliminarHoja
    QuitarDuplicados
    Cartelera
End Sub

Ahora solo nos resta llevar al sub Iniciar al evento Open del Workbook:

Link al archivo, y gracias por los mails que a diario me hacen llegar. Disculpen si me demoro un poco en contestar, pero el tiempo es tirano.