Exchange rate (1 Viewer)

Gismo said:
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
Click to expand...
Hi,

Still struggling with this code
 

Attachments

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

Attachments

arnelgp said:
i don't think you need CurrencyFrom and CurrencyTo fields.
Click to expand...
Thank you arnelgp
I made the changes as per you sample, much appreciated

I am still getting an error on code
StrToDbl = CDbl(sRet)
Click to expand...

1668487489542.png





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
 
Last edited:
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?
 
Gismo said:
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?
Click to expand...
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.
 
Gasman said:
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.
Click to expand...
I did the breakpoint as advised

I get the error in:
StrToDbl = CDbl(sRet)
Click to expand...

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
Click to expand...

I also get the same error when I open the DB that arnelgp sent me
 
Last edited:
Do you not indent your code? :(

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?

Code: 
? 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.
 
Gasman said:
Do you not indent your code? :(

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?

Code: 
? 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.
Click to expand...
Debug.Print sRet gives me a value of 216.502297

I assume the error is with StrToDdl
 
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?
 
Gasman said:
And what is the string you are passing to it?
Show how you are calling that function.
Click to expand...
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
Click to expand...

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
Click to expand...

1668805197309.png
 
Last edited:
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!!!
 
Gasman said:
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!!!
Click to expand...
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

1668805765578.png


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
Click to expand...
 
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. :(
 
Gasman said:
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. :(
Click to expand...
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
Click to expand...
 
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. :(
 
Gasman said:
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. :(
Click to expand...
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

 

Attachments

You need to place the code tags first before inserting any code.
 
Gismo said:
Debug.Print sRet gives me a value of 216.502297
Click to expand...
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.
 
You must log in or register to reply here.

Similar threads

M
Auto update of exchange rates
Replies
3
Views
616
SusieEdwards
S
GUIDO22
Subquery for CurrencyRate
Replies
3
Views
439
GUIDO22
GUIDO22
M
Updating another field in the same record on update of another field
Replies
2
Views
452
The_Doc_Man
The_Doc_Man
P
Convert to Access SQL
Replies
8
Views
349
Pat Hartman
P
B
Aggregate in subquery
Replies
5
Views
690
Bob
B

Users who are viewing this thread

Total: 2 (members: 0, guests: 2)
Back
Top Bottom