Skip to content

Instantly share code, notes, and snippets.

@capm
Created April 4, 2017 14:58
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save capm/371337954748fa00ead25582287ae3ba to your computer and use it in GitHub Desktop.
Save capm/371337954748fa00ead25582287ae3ba to your computer and use it in GitHub Desktop.
Download USDPEN FX rate from SBS website
Sub FXSBS()
'
' FXSBS Macro
'
' Declare variables
Dim wbMain As Workbook
Dim wsMain As Worksheet
Dim urlFX As String
Dim dateStart As Date, dateEnd As Date
' Internet objects
Dim oHtml As HTMLDocument
' Set environment variables
Set wbMain = ActiveWorkbook
Set wsMain = ActiveSheet
' Find last date
dateStart = Format(WorksheetFunction.WorkDay(wsMain.Cells(FindLastCell(wsMain, 1, 0), 1), 1), "dd/mm/yyyy")
If dateStart = Date Then Exit Sub
dateEnd = Format(Date, "dd/mm/yyyy")
urlFX = "http://www.sbs.gob.pe/app/stats/seriesH-tipo_cambio_moneda_excel.asp?fecha1=" & dateStart & "&fecha2=" & dateEnd & "&moneda=02"
' Get raw HTML
Set oHtml = New HTMLDocument
oHtml.body.innerHTML = GetRawHTML(urlFX)
'MsgBox oHtml.body.innerHTML
' Extract table from html
Dim tableFX As HTMLTable
Set tableFX = oHtml.getElementsByTagName("Table").Item(0)
'MsgBox tableFX.innerHTML
Dim tableFXRow As HTMLTableRow
For Each tableFXRow In tableFX.Rows
If Not tableFXRow.Cells(0).innerText = "FECHA " Then
Dim rPosition As Integer
rPosition = FindLastCell(wsMain, 1, 0) + 1
' Date
wsMain.Cells(rPosition, 1).Value = DateSerial(Mid(tableFXRow.Cells(0).innerText, 7, 4), Mid(tableFXRow.Cells(0).innerText, 4, 2), Left(tableFXRow.Cells(0).innerText, 2))
' Bid
wsMain.Cells(rPosition, 2).Value = tableFXRow.Cells(2).innerText
' Ask
wsMain.Cells(rPosition, 3).Value = tableFXRow.Cells(3).innerText
End If
Next tableFXRow
'
End Sub
Public Function GetRawHTML(urlWebSite As String)
'
Set GetRawHTML = New HTMLDocument
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
.Open "GET", urlWebSite, False
.send
GetRawHTML = .responseText
End With
' Use it this way:
' Set oHtml = New HTMLDocument
' oHtml.body.innerHTML = GetRawHTML(urlWebSite)
End Function
Public Function FindLastCell(wsEval As Worksheet, wsCol As Integer, fType As Integer) As Long
' wsCol: Row or column number.
' fType can be 0 or 1.
' 0: Find last row in column
' 1: Find last column in row
'
If fType = 0 Then
FindLastCell = wsEval.Cells(wsEval.Rows.Count, wsCol).End(xlUp).Row
End If
If fType = 1 Then
FindLastCell = wsEval.Cells(1, wsEval.Columns.Count).End(xlToLeft).Column
End If
If fType <> 0 And fType <> 1 Then
MsgBox "Must choose find last row in column or find last column in row."
End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment