Macro to download zip, unpack and copy data

[HeinrichPaul]

Hello All,

I found a macro from @ZVI which I think should do what I need, download a file from a page, open the zip file, copy the contents of the CSV and paste it into a tab in the file that also contains the macro. After inserting the link it always says file not found. Since the link keeps changing, I took this into account, but the error remains. I don't know where the file is looking for and not found. I assume in the Temp folder.
Can anyone help me on that resp. what's the issue? Today I found also here one Download exchange rate using web scrapping, the download works, but to add something from I couldn't get it working.

Here is the code:
Sub DownloadZipExtractCsvAndLoad_01()
'ZVI:2017-01-07 Need vba to download and copy the data from zip file
'ZVI:2018-09-11 Updated code with destination range constants

' --> User settings, change to suit
Const DestSheet = "F_X-rates"
Const DestCell = "C4"
'<-- End of the user settings

Dim UrlFile As String, ZipFile As String, CsvFile As String, Folder As String, s As String, DestWorkbook As String

' UrlFile to the ZIP archive with CSV file
UrlFile = [D4]

' Extract ZipFile, CsvFile from UrlFile
ZipFile = Mid(UrlFile, InStrRev(UrlFile, "/") + 1)
CsvFile = Left(ZipFile, Len(ZipFile) - 4)

' Define temporary folder (updated 2018-09-11)
Folder = Environ("TEMP")
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"

' Disable screen updating to avoid blinking
Application.ScreenUpdating = False

' Trap errors
On Error GoTo exit_

' Download UrlFile to ZipFile in Folder
If Not Url2File(UrlFile, Folder & ZipFile) Then
MsgBox "Can't download file" & vbLf & UrlFile, vbCritical, "Error"
Exit Sub
End If

' Extract CsvFile from ZipFile
If Len(Dir(Folder & CsvFile)) Then Kill Folder & CsvFile
With CreateObject("Shell.Application").Namespace((Folder))
.CopyHere Folder & ZipFile & "\" & CsvFile
End With
Kill Folder & ZipFile

' Delete temporary folders to prevent saturation of Shell.Application
With CreateObject("Scripting.FileSystemObject")
s = Dir(Folder & "\*" & ZipFile, vbDirectory + vbHidden)
While Len(s)
.DeleteFolder Folder & s, True
s = Dir()
Wend
End With

' Import CsvFile to Excel
With Workbooks.Open(Folder & CsvFile).Sheets(1)
.UsedRange.Columns(1).TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(3, 4), Array(15, 4)), TrailingMinusNumbers:=True
' Autofit the widths
.UsedRange.Columns.AutoFit

' Copy sheet to the new workbook
'.Copy

' Copy data to the destination range (updated 2018-09-11)
.UsedRange.Copy Workbooks(DestWorkbook).Sheets(DestSheet).Range(DestCell)

' Release (close) CsvFile
.Parent.Close False
End With

' Delete CsvFile
Kill Folder & CsvFile

exit_:

' Restore screen updating
Application.ScreenUpdating = True

' Inform about the reason of the trapped error
If Err Then MsgBox Err.Description, vbCritical, "Error"

End Sub

Function Url2File(UrlFile As String, PathName As String, Optional Login As String, Optional Password As String) As Boolean
'ZVI:2017-01-07 Download UrlFile and save it to PathName.
' Use optional Login and Password if required.
' Returns True on success downloading.
Dim b() As Byte, FN As Integer
On Error GoTo exit_
If Len(Dir(PathName)) Then Kill PathName
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", UrlFile, False, Login, Password
.send
If .Status <> 200 Then Exit Function
b() = .responseBody
FN = FreeFile
Open PathName For Binary Access Write As FN
Put FN, , b()
exit_:
If FN Then Close FN
Url2File = .Status = 200
End With
End Function

The URL under D4 is https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist.zip?14e24ef8ca6d0252f5283421cbcfc698 which I have changed to https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist.zip?&"*" as it seems to change every now and then.

Best Regards
HeinrichPaul