Odtnhj

I want to write a date in excel and get the rate by this date.

I search solutions but not found something that can help me.

It's could be vba or non vba, someone have a solution for me?

I am using Excel 2016.

Thank you.

My code:

Function CryptoQuote(enteredDate As String)
 If IsDate(enteredDate) Then
 enteredDate = Format(Date, "yyyy-mm-dd")
 Dim strURL As String: strURL = "http://www.x-rates.com/historical/?from=USD&amount=1&date=" & enteredDate
 MsgBox strURL
 Dim http As Object: Set http = CreateObject("msxml2.xmlhttp")
 http.Open "GET", strURL, False
 http.Send
 Dim strCSV As String
 Found = InStr(http.responseText, "/graph/?from=USD&to=ILS") 'find this in the HTML
 If Found <> 0 Then
 Length = Len(http.responseText) - Found 'check the length of the HTML
 strCSV = Right(http.responseText, Length) 'Trim the begining of the String until we get to our value
 strCSV = Left(strCSV, Len(strCSV) - (Len(strCSV) - 36)) 'Trim the end of the string to leave only the value we are looking for
 strCSV = Replace(strCSV, "graph/?from=USD&amp;to=ILS'>", "") 'replace the original search string with nothing so we are left with numbers only
 Else
 CryptoQuote = "Could not find the data!"
 End If
 Else
 MsgBox "Please enter a correct date as yyyy-mm-dd"
 End If
 CryptoQuote = Val(strCSV)
 MsgBox strCSV
End Function

If what you want is USD to EUR then this will do the job (not the most elegant way of doing things but it will do the task at hand):

Public Sub CryptoQuote()
 enteredDate = InputBox("Please enter the search date: ", "Enter Date")
 If IsDate(enteredDate) Then
 enteredDate = Format(Date, "yyyy-mm-dd")
 Dim strURL As String: strURL = "http://www.x-rates.com/historical/?from=USD&amount=1&date=" & enteredDate
 Dim http As Object: Set http = CreateObject("msxml2.xmlhttp")
 http.Open "GET", strURL, False
 http.send
 Dim strCSV As String
 Found = InStr(http.responsetext, "/graph/?from=USD&to=EUR") 'find this in the HTML
 If Found <> 0 Then
 Length = Len(http.responsetext) - Found 'check the length of the HTML
 strCSV = Right(http.responsetext, Length) 'Trim the begining of the String until we get to our value
 strCSV = Left(strCSV, Len(strCSV) - (Len(strCSV) - 36)) 'Trim the end of the string to leave only the value we are looking for
 strCSV = Replace(strCSV, "graph/?from=USD&amp;to=EUR'>", "") 'replace the original search string with nothing so we are left with numbers only
 Else
 MsgBox "Could not find the data!"
 End If
 Else
 MsgBox "Please enter a correct date as yyyy-mm-dd"
 End If
 MsgBox "The rate for 1 USD in EURO is " & strCSV
End Sub

Is this what you want?

Sub gethtmltable()
 Dim objWeb As QueryTable
 Dim sWebTable As String
 'You have to count down the tables on the URL listed in your query
 'This example shows how to retrieve the 2nd table from the web page.
 sWebTable = 2
 'Sets the url to run the query and the destination in the excel file
 'You can change both to suit your needs

 LValue = Format(Date, "yyyy-mm-dd")
 Set objWeb = ActiveSheet.QueryTables.Add( _
 Connection:="URL;http://www.x-rates.com/historical/?from=USD&amount=1&date=" & LValue, _
 Destination:=Range("A1"))

 With objWeb

 .WebSelectionType = xlSpecifiedTables
 .WebTables = sWebTable
 .Refresh BackgroundQuery:=False
 .SaveData = True
 End With
 Set objWeb = Nothing
End Sub

They changed to HTTPS, so make sure that you use https://www.x-rates.com over http://www.x-rates.com. The rest works fine without changes.