Excel - VBA - Parsing International Currency Amounts in VBA

VBA Currency Parsing is limited to one's own currency

So parsing currencies in ordinary VBA can work so long as one sticks to one's own currency, so the following, CCur can handle commas and minus signs and on my machine Sterling Pound symbol but trips up on dollars.

Sub Test()

    Debug.Assert VBAParseCCur("1000") = 1000
    Debug.Assert VBAParseCCur("-1000") = -1000
    Debug.Assert VBAParseCCur("-10,000") = -10000
    
    Debug.Assert VBAParseCCur("£-10,000") = -10000 '* works on my (UK) machine
    Debug.Assert VBAParseCCur("$-10,000") = -10000  '* fails on my (UK) machine

End Sub

Function VBAParseCCur(v)
    On Error Resume Next
    VBAParseCCur = CCur(v)
End Function

COM System Parsers

So typically C++ programmers have greater access to the system functions than VBA programmers. A C++ programmer can call VarParseNumFromStr to parse a number out of a string.

HRESULT VarParseNumFromStr(
  LPCOLESTR strIn,
  LCID      lcid,
  ULONG     dwFlags,
  NUMPARSE  *pnumprs,
  BYTE      *rgbDig
);

One can see that one can specify the locale id as second parameter. If you know what you want, in this case I want a currency from a string then you can chose a more specific parsing function, VarCyFromStr

HRESULT VarCyFromStr(
  LPCOLESTR strIn,
  LCID      lcid,
  ULONG     dwFlags,
  CY        *pcyOut
);

With the help of VBFormus.com expert Olaf Schmidt we can call VarCyFromStr from VBA. And now we have the ability to parse multi-currency strings, see this code.

Option Explicit


'* http://www.vbforums.com/showthread.php?762443-VB6-Tabulator-Crosstab-Class
'* https://docs.microsoft.com/en-gb/previous-versions/windows/desktop/api/oleauto/nf-oleauto-varcyfromstr
Private Declare Function VarCyFromStr& Lib "oleaut32" (ByVal sDate&, ByVal LCID&, ByVal Flags&, C As Currency)

Private Enum lcidLocaleId
    lcidEN_US = 1033    '* US
    lcidEN_EN = 2057    '* UK
    lcidFR_FR = 1036    '* Eurozone
    lcidRU = 1049       '* Russia
    lcidJA = 1041       '* Japan
End Enum

Private Enum chrwCurrencies
    chrwEuro = 8364     '* for euros
    chrwRouble = 8381   '* for roubles
    chrwYen = 165       '* for yen
End Enum

Private Function CCurLA(ByVal sAmount As String, ByVal LCID As lcidLocaleId) As Currency
    Dim HRes As Long
    
    HRes = VarCyFromStr(StrPtr(sAmount), LCID, 0, CCurLA)
    If HRes Then Err.Raise HRes
End Function

Sub TestVarCyFromStr_Yen()

    Dim sYen As String
    sYen = ChrW(chrwYen) & "-1000"
    Dim curYen As Currency
    
    curYen = CCurLA(sYen, lcidJA)
    Debug.Assert curYen = -1000
End Sub

Sub TestVarCyFromStr_Roubles()

    Dim sRoubles As String
    sRoubles = ChrW(chrwRouble) & "-1000"
    Dim curRoubles As Currency
    
    curRoubles = CCurLA(sRoubles, lcidRU)
    Debug.Assert curRoubles = -1000
End Sub

Sub TestVarCyFromStr_Euros()

    Dim sEuros As String
    sEuros = ChrW(chrwEuro) & "-1000"
    Dim curEuros As Currency
    
    curEuros = CCurLA(sEuros, lcidFR_FR)
    Debug.Assert curEuros = -1000
End Sub

Sub TestVarCyFromStr_Dollars()

    Dim sDollars As String
    sDollars = "$-10,00"
    Dim curDollars As Currency
    
    curDollars = CCurLA(sDollars, lcidEN_US)
    Debug.Assert curDollars = -1000
End Sub

Sub TestVarCyFromStr_Pounds()

    Dim sPounds As String
    sPounds = "£-10,00"
    Dim curPounds As Currency
    
    curPounds = CCurLA(sPounds, lcidEN_EN)
    Debug.Assert curPounds = -1000
End Sub