Exchange rate (1 Viewer)

[Gismo]

Thank you arnelgp

Where are you saving the exchange rate?

I am still getting the same error in the code when I open you DB
Type mismatch

Hi,

Still struggling with this code

 

[arnelgp]

i don't think you need CurrencyFrom and CurrencyTo fields.

 

[Gismo]

i don't think you need CurrencyFrom and CurrencyTo fields.

Thank you arnelgp
I made the changes as per you sample, much appreciated

I am still getting an error on code

StrToDbl = CDbl(sRet)

I am also still struggling with the control "Mass" , when massrequired = yes, the control is not active
When massrequired = no then control is not active either

 

[Gismo]

Hi Arnelgp,

I am still struggling with the error as mention in a previous post
Could you please advise what I should be looking out for?

 

[arnelgp]

I am still struggling with the error as mention in a previous post

sorry i cannot re-produced that error.

 

[Gismo]

sorry i cannot re-produced that error.

I get the same error when I open the DB you sent me as well

 

[Gasman]

Hi Arnelgp,

I am still struggling with the error as mention in a previous post
Could you please advise what I should be looking out for?

Well, as no one else appears to have the error , set a breakpoint at the start of where the code gets executed and walk though it LINE BY LINE until you get the error. Then report back the line the error happens (with the code) on and the contents/type of the data in that line.

 

[Gismo]

Well, as no one else appears to have the error , set a breakpoint at the start of where the code gets executed and walk though it LINE BY LINE until you get the error. Then report back the line the error happens (with the code) on and the contents/type of the data in that line.

I did the breakpoint as advised

I get the error in:

StrToDbl = CDbl(sRet)

Public Function StrToDbl(ByVal s As String) As Double
Const Keys As String = ",.0123456789"
Dim sRet As String, char As String
Dim i As Long, ln As Long
ln = Len(s)
For i = ln To 1 Step -1
char = Mid$(s, i, 1)
If InStr(1, Keys, char) <> 0 Then
If char <> "," Then
sRet = char & sRet
End If
Else
Exit For
End If
Next
StrToDbl = CDbl(sRet)
End Function

I also get the same error when I open the DB that arnelgp sent me

 

[Gasman]

Do you not indent your code?

Public Function StrToDbl(ByVal s As String) As Double
    Const Keys As String = ",.0123456789"
    Dim sRet As String, char As String
    Dim i As Long, ln As Long
    ln = Len(s)
    For i = ln To 1 Step -1
        char = Mid$(s, i, 1)
        If InStr(1, Keys, char) <> 0 Then
            If char <> "," Then
                sRet = char & sRet
            End If
        Else
            Exit For
        End If
    Next
    StrToDbl = CDbl(sRet)
End Function

You are passing a string to it are you not?

? strtodbl("23.75")
 23.75

What is the value of sRet on that line?
Hover over the variable name with the cursor and it will show you the value.

 

[Gismo]

Do you not indent your code?

Public Function StrToDbl(ByVal s As String) As Double
    Const Keys As String = ",.0123456789"
    Dim sRet As String, char As String
    Dim i As Long, ln As Long
    ln = Len(s)
    For i = ln To 1 Step -1
        char = Mid$(s, i, 1)
        If InStr(1, Keys, char) <> 0 Then
            If char <> "," Then
                sRet = char & sRet
            End If
        Else
            Exit For
        End If
    Next
    StrToDbl = CDbl(sRet)
End Function

You are passing a string to it are you not?

? strtodbl("23.75")
23.75

What is the value of sRet on that line?
Hover over the variable name with the cursor and it will show you the value.

Debug.Print sRet gives me a value of 216.502297

I assume the error is with StrToDdl

 

[Gasman]

And what is the string you are passing to it?
Show how you are calling that function.

Hover over sRet at that line and show EXACTLY what is shown.
Mine shows "23.75". Notice the quotes?

 

[Gismo]

And what is the string you are passing to it?
Show how you are calling that function.

Private Sub Product_AfterUpdate()
DoCmd.SetWarnings False
EnableDisableMass
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenQuery "Update Transaction - Procurement - Temp - Currency"
DoCmd.OpenQuery "Update Transaction - Procurement - Temp - UOM"
Me.Mass.Enabled = Me.MassRequired
Me.Mass.TabStop = Me.MassRequired
EnableDisableMass
DoCmd.GoToControl "Qty"
Qty.Requery
DoCmd.SetWarnings True


Dim value As Currency
If Not IsDate(Me.[Transaction Date]) Then
MsgBox "Please enter a valid date!"
Exit Sub
End If

Call fncUpdateFields

End Sub

Public Function fncUpdateFields()
Me.Parent!txtDate = Me![Transaction Date]
Me.Parent!txtExchange = ToUGX(Me.Parent!txtDate, Me.Parent!Currency)
Me![Exchange Rate] = Me.Parent!txtExchange
Me![Currency] = Me.Parent![Currency]
End Function

 

[Gasman]

So where in that code are you using that function???
You are showing output in the immediate window, but not how it is output.
Hover over sret on that line and tell us EXACTLY what is shown!!!

 

[Gismo]

So where in that code are you using that function???
You are showing output in the immediate window, but not how it is output.
Hover over sret on that line and tell us EXACTLY what is shown!!!

I am using the code in post 22
I dont get any values displayed when hovering over sret

The output on the form is blank

Option Explicit

' arnelgp
' for gismo
'
Public Function GBP2Uganda(ByVal ExchangeDate As Variant) As Currency
Const TEXT_SOUGHT_FOR1 As String = "<td class=""tableCell""><a href=""currency/ugx/"">Ugandan shilling</a></td>"
Const TEXT_SOUGHT_FOR2 As String = "<td class=""tableCell"" align=""right"">"
Dim oXML As Object
Dim URL As String, the_file As String, ISODate As String
Dim strData As String, n As Long, xchng As Currency
' check if there is a valid date passed
If IsDate(ExchangeDate) = False Then
Exit Function
End If
ISODate = Format$(ExchangeDate, "yyyy-mm-dd")
URL = "http://www.floatrates.com/historical-exchange-rates.html?currency_date=" & ISODate & "&base_currency_code=GBP&format_type=html"
Set oXML = CreateObject("MSXML2.XMLHTTP")
With oXML
'.Open "GET", "http://www.floatrates.com/daily/usd.xml"
.Open "GET", URL
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
'Debug.Print .responsetext
'Exit Sub
Do While .ReadyState <> 4
'Debug.Print .ReadyState
DoEvents
Loop
strData = .responsetext
End With
Set oXML = Nothing
' find this value from strData:
' <td class="tableCell"><a href="currency/ugx/">Ugandan shilling</a></td>
n = InStr(1, strData, TEXT_SOUGHT_FOR1)
'Debug.Print n
If (n <> 0) Then
' find the exchange rate
n = InStr(n, strData, TEXT_SOUGHT_FOR2)
If (n <> 0) Then
strData = Trim$(Mid$(strData, n + Len(TEXT_SOUGHT_FOR2)))
n = InStr(1, strData, "</td>")
If (n <> 0) Then
xchng = CCur(Left$(strData, n - 1))
End If
End If
End If
strData = vbNullString
'Debug.Print xchng
GBP2Uganda = xchng
End Function


Public Function ToUGX(ByVal ExchangeDate As Variant, ByVal CurrencyCode) As Double
Const TEXT_FIND As String = "<td class=""tableCell""><a href=""currency/@1/"">@2</a></td>"
Const TEXT_SOUGHT_FOR2 As String = "<td class=""tableCell"" align=""right"">"
Dim oXML As Object
Dim URL As String, the_file As String, ISODate As String
Dim strData As String, n As Long, xchng As Double
Dim TEXT_SOUGHT_FOR1 As String, sCurrencyDescription As String
TEXT_SOUGHT_FOR1 = Replace$(Replace$(TEXT_FIND, "@1", CurrencyCode), "@2", _
DLookup("Description", "Location_Currency", "Currency = '" & CurrencyCode & "'"))
' check if there is a valid date passed
If IsDate(ExchangeDate) = False Then
Exit Function
End If
ISODate = Format$(ExchangeDate, "yyyy-mm-dd")
URL = "http://www.floatrates.com/historical-exchange-rates.html?currency_date=" & ISODate & "&base_currency_code=UGX&format_type=html"
Set oXML = CreateObject("MSXML2.XMLHTTP")
With oXML
'.Open "GET", "http://www.floatrates.com/daily/usd.xml"
.Open "GET", URL
.setRequestHeader "User-Agent", "Mozilla/5.0"
.send
'Debug.Print .responsetext
'Exit Sub
Do While .ReadyState <> 4
'Debug.Print .ReadyState
DoEvents
Loop
strData = .responsetext
End With
Set oXML = Nothing
'WriteToText Environ("USERPROFILE") & "\Desktop\xchange.txt", strData
'Exit Function
' find this value from strData:
' <td class="tableCell"><a href="currency/ugx/">Ugandan shilling</a></td>
n = InStr(1, strData, TEXT_SOUGHT_FOR1)
'Debug.Print n
If (n <> 0) Then
' find the exchange rate
n = InStr(n, strData, TEXT_SOUGHT_FOR2)
If (n <> 0) Then
strData = Trim$(Mid$(strData, n + Len(TEXT_SOUGHT_FOR2)))
n = InStr(1, strData, "</td>")
If (n <> 0) Then
' get the second instance
n = InStr(n, strData, TEXT_SOUGHT_FOR2)
strData = Trim$(Mid$(strData, n + Len(TEXT_SOUGHT_FOR2)))
n = InStr(1, strData, "</td>")
xchng = StrToDbl(Left$(strData, n - 1))
End If
End If
End If
strData = vbNullString
'Debug.Print xchng
ToUGX = xchng
End Function

Public Sub WriteToText(ByVal spath As String, ByVal the_content As String)
Open spath For Output As #1
Print #1, the_content
Close #1
End Sub

Public Function StrToDbl(ByVal s As String) As Double
Const Keys As String = ",.0123456789"
Dim sRet As String, char As String
Dim i As Long, ln As Long
ln = Len(s)
For i = ln To 1 Step -1
char = Mid$(s, i, 1)
If InStr(1, Keys, char) <> 0 Then
If char <> "," Then
sRet = char & sRet
End If
Else
Exit For
End If
Next
Debug.Print sRet
StrToDbl = CDbl(sRet)

End Function

 

[Gasman]

So one minute you post a value from sret, now you say you do not get any value?
You still have not shown how you are calling it or what value is passed.

Have looked to see what strdata is?, either before you pass it, or as soon as it enters that function.

Look at the debbuging link in my signature and watch a few of the videos.

I am out of this for the rest of the night.

 

[Gismo]

So one minute you post a value from sret, now you say you do not get any value?
You still have not shown how you are calling it or what value is passed.

Have looked to see what strdata is?, either before you pass it, or as soon as it enters that function.

Look at the debbuging link in my signature and watch a few of the videos.

I am out of this for the rest of the night.

The form has no vale
The immediate window gives an output

Below is where I call the function, post 34

Private Sub Product_AfterUpdate()
DoCmd.SetWarnings False
EnableDisableMass
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenQuery "Update Transaction - Procurement - Temp - Currency"
DoCmd.OpenQuery "Update Transaction - Procurement - Temp - UOM"
Me.Mass.Enabled = Me.MassRequired
Me.Mass.TabStop = Me.MassRequired
EnableDisableMass
DoCmd.GoToControl "Qty"
Qty.Requery
DoCmd.SetWarnings True


Dim value As Currency
If Not IsDate(Me.[Transaction Date]) Then
MsgBox "Please enter a valid date!"
Exit Sub
End If

Call fncUpdateFields

End Sub

 

[Gasman]

I am going to leave this to @arnelgp as it is his code and he knows how it all fits together.
You are not able to carry out simple debug tasks, and as you do not know what the code does, makes it hard to debug from afar.

You also seem incapable of indenting your code, which makes the task even harder. I am sure arnel never gave you code indented like that?

I was trying trying to go through the steps I would take to get to the bottom of the problem, but that proves to be extremely difficult with you. so I will bow out now. Sorry.

 

[Gismo]

I am going to leave this to @arnelgp as it is his code and he knows how it all fits together.
You are not able to carry out simple debug tasks, and as you do not know what the code does, makes it hard to debug from afar.

You also seem incapable of indenting your code, which makes the task even harder. I am sure arnel never gave you code indented like that?

I was trying trying to go through the steps I would take to get to the bottom of the problem, but that proves to be extremely difficult with you. so I will bow out now. Sorry.

Thank you for your assistance

The code was given indented , also same in my DB, not sure why when I copy and past the code it does not have the indentation, apologies

But the code supplied by arnelgp in the DB in post 22 is the full code supplied and was copied as is.

Attached again

 

[Gasman]

You need to place the code tags first before inserting any code.

 

[sonic8]

Debug.Print sRet gives me a value of 216.502297

I suspect the problem is that the currency conversion code you are using is always applying the dot as decimal separator (in strings) while your local decimal separator is a comma.
Not knowing the code, I cannot suggest a practical fix for the problem, but this info might help @arnelgp reproducing the issue.