S
Steve Feldman
Hi all!
I wanted to write a UDF that would have Excel return the Canadian to US
currency exchange rate for a specified date. I wanted to have the UDF reside
in an addin. I wanted to use Oanda's website to find the rates
(http://www.oanda.com).
At first, I tried using a programatically invoked web-query, but this didn't
do the job because a function cannot change external ranges, and web queries
(apparently) can only be be dumped to a worksheet range. (I thought maybe I
could create a "virtual" range in memory, but no luck there.)
So, my next idea was to use the MSHTML library to pull down the data. This
actually worked pretty well, BUT would wind up leaving Excel open for
crashing, as I had to use a "do events" statement in the routine (waiting
for the page to load), which would return user-control to Excel during the
calculation process. The user could move the cursor and enter data while
Excel was actually calculating the page, and this would cause Excel to
crash.
So, my next idea was to control the calculation of the function from a SUB,
rather than from simply letting the Excel application invoke the function
itself as it was calculating. The add-in now adds a menu item called "Oanda"
where the user can choose to calculate the entire workbook, including my
custom functions. This works. User-interactivity is cut-off during the
calculation process.
(The function assumes you're connected to the internet. I haven't tried to
invoke it from a machine that does not have an internet connection.)
My question is: Is there a better way to do this? a faster way? a cleaner
way? a more "proper" way?
The function takes the following format: "=EXCHANGE(serial_number)" where
the serial number is a standard numeric date value.
To calculate any of these custom functions, click Oanda, then "Query Oanda
Rates"
The code is below.
If you want to build the add-in yourself, open the VBE, add a reference to
"Microsoft HTML Object Library".
Put the following code in the "This Workbook" module:
'***************************************************************
Private Sub Workbook_Open()
Application.EnableCancelKey = xlDisabled
FetchOkay = False
Call CreateMenu(True)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableCancelKey = xlDisabled
Call DeleteMenu(True)
End Sub
'***************************************************************
Add a new module, and put the following code in it:
'***************************************************************
Option Explicit
Public FetchOkay As Boolean
Private ExchangeValue As Single
Private uMonth, uDay, uYear As Integer
Public Function exchange(uDate As Date)
If FetchOkay = False Then Exit Function
On Error Resume Next
uMonth = Month(uDate)
uDay = Day(uDate)
uYear = Year(uDate)
Dim X As New MSHTML.HTMLDocument
Dim Y As New MSHTML.HTMLDocument
Set Y =
X.createDocumentFromUrl("http://www.oanda.com/convert/classic?user=printable
&exch=CAD&value=1&expr=USD&date_fmt=us&date=" _
& Format(uMonth, "00") & "/" & Format(uDay, "00") & "/" &
Right(Format(uYear, "0000"), 2) & "&lang=en", vbNullString)
Do While Y.readyState <> "loaded" And Y.readyState <> "complete"
DoEvents
Loop
ExchangeValue = Val(Mid(Y.documentElement.innerHTML, InStr(1,
Y.documentElement.innerHTML, "Canadian Dollar =", vbTextCompare) + 18, 7))
If ExchangeValue <> 0 Then exchange = ExchangeValue Else exchange =
"#DATE?"
Set X = Nothing
Set Y = Nothing
End Function
Private Sub Fetch_Exchange_Rates()
Application.EnableCancelKey = xlDisabled
Application.Interactive = False
Application.EnableEvents = False
FetchOkay = True
Application.CalculateFull
Application.EnableEvents = True
Application.Interactive = True
FetchOkay = False
End Sub
Public Sub CreateMenu(ByVal DummyVariable As Boolean)
Application.EnableCancelKey = xlDisabled
Dim HelpMenu As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim SubMenuItem As CommandBarButton
'Delete the menu if it already existed
Call DeleteMenu(True)
'Find the Help Menu
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
If HelpMenu Is Nothing Then 'add menu to the end
Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup,
temporary:=True)
Else 'add the menu before Help
Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup,
before:=HelpMenu.Index, temporary:=True)
End If
NewMenu.Caption = "O&anda"
Set SubMenuItem = NewMenu.Controls.Add(Type:=msoControlButton)
With SubMenuItem
.Caption = "&Query Oanda Rates"
.OnAction = "Fetch_Exchange_Rates"
End With
End Sub
Public Sub DeleteMenu(ByVal DummyVariable As Boolean)
On Error Resume Next
CommandBars(1).Controls("Oanda").Delete
End Sub
'***************************************************************
Compile, and bim bam boom, that should do it.
Any suggestions?
Thanks!
Steve
I wanted to write a UDF that would have Excel return the Canadian to US
currency exchange rate for a specified date. I wanted to have the UDF reside
in an addin. I wanted to use Oanda's website to find the rates
(http://www.oanda.com).
At first, I tried using a programatically invoked web-query, but this didn't
do the job because a function cannot change external ranges, and web queries
(apparently) can only be be dumped to a worksheet range. (I thought maybe I
could create a "virtual" range in memory, but no luck there.)
So, my next idea was to use the MSHTML library to pull down the data. This
actually worked pretty well, BUT would wind up leaving Excel open for
crashing, as I had to use a "do events" statement in the routine (waiting
for the page to load), which would return user-control to Excel during the
calculation process. The user could move the cursor and enter data while
Excel was actually calculating the page, and this would cause Excel to
crash.
So, my next idea was to control the calculation of the function from a SUB,
rather than from simply letting the Excel application invoke the function
itself as it was calculating. The add-in now adds a menu item called "Oanda"
where the user can choose to calculate the entire workbook, including my
custom functions. This works. User-interactivity is cut-off during the
calculation process.
(The function assumes you're connected to the internet. I haven't tried to
invoke it from a machine that does not have an internet connection.)
My question is: Is there a better way to do this? a faster way? a cleaner
way? a more "proper" way?
The function takes the following format: "=EXCHANGE(serial_number)" where
the serial number is a standard numeric date value.
To calculate any of these custom functions, click Oanda, then "Query Oanda
Rates"
The code is below.
If you want to build the add-in yourself, open the VBE, add a reference to
"Microsoft HTML Object Library".
Put the following code in the "This Workbook" module:
'***************************************************************
Private Sub Workbook_Open()
Application.EnableCancelKey = xlDisabled
FetchOkay = False
Call CreateMenu(True)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableCancelKey = xlDisabled
Call DeleteMenu(True)
End Sub
'***************************************************************
Add a new module, and put the following code in it:
'***************************************************************
Option Explicit
Public FetchOkay As Boolean
Private ExchangeValue As Single
Private uMonth, uDay, uYear As Integer
Public Function exchange(uDate As Date)
If FetchOkay = False Then Exit Function
On Error Resume Next
uMonth = Month(uDate)
uDay = Day(uDate)
uYear = Year(uDate)
Dim X As New MSHTML.HTMLDocument
Dim Y As New MSHTML.HTMLDocument
Set Y =
X.createDocumentFromUrl("http://www.oanda.com/convert/classic?user=printable
&exch=CAD&value=1&expr=USD&date_fmt=us&date=" _
& Format(uMonth, "00") & "/" & Format(uDay, "00") & "/" &
Right(Format(uYear, "0000"), 2) & "&lang=en", vbNullString)
Do While Y.readyState <> "loaded" And Y.readyState <> "complete"
DoEvents
Loop
ExchangeValue = Val(Mid(Y.documentElement.innerHTML, InStr(1,
Y.documentElement.innerHTML, "Canadian Dollar =", vbTextCompare) + 18, 7))
If ExchangeValue <> 0 Then exchange = ExchangeValue Else exchange =
"#DATE?"
Set X = Nothing
Set Y = Nothing
End Function
Private Sub Fetch_Exchange_Rates()
Application.EnableCancelKey = xlDisabled
Application.Interactive = False
Application.EnableEvents = False
FetchOkay = True
Application.CalculateFull
Application.EnableEvents = True
Application.Interactive = True
FetchOkay = False
End Sub
Public Sub CreateMenu(ByVal DummyVariable As Boolean)
Application.EnableCancelKey = xlDisabled
Dim HelpMenu As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim SubMenuItem As CommandBarButton
'Delete the menu if it already existed
Call DeleteMenu(True)
'Find the Help Menu
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
If HelpMenu Is Nothing Then 'add menu to the end
Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup,
temporary:=True)
Else 'add the menu before Help
Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup,
before:=HelpMenu.Index, temporary:=True)
End If
NewMenu.Caption = "O&anda"
Set SubMenuItem = NewMenu.Controls.Add(Type:=msoControlButton)
With SubMenuItem
.Caption = "&Query Oanda Rates"
.OnAction = "Fetch_Exchange_Rates"
End With
End Sub
Public Sub DeleteMenu(ByVal DummyVariable As Boolean)
On Error Resume Next
CommandBars(1).Controls("Oanda").Delete
End Sub
'***************************************************************
Compile, and bim bam boom, that should do it.
Any suggestions?
Thanks!
Steve