Option Explicit
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
'Purpose : Download file from a web site
'Inputs : sURLFileName The URL and file name to download.
' sSaveToFile The filename to save the file to.
' [bOverwriteExisting] If True overwrites the file if it existings
'Outputs : Returns True on success.
Function InternetGetFile(sURLFileName As String, sSaveToFile As String, Optional bOverwriteExisting As Boolean = False) As Boolean
Dim lRet As Long
Const S_OK As Long = 0, E_OUTOFMEMORY = &H8007000E
Const INTERNET_OPEN_TYPE_PRECONFIG = 0, INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_OPEN_TYPE_DIRECT = 1, INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
On Error Resume Next
'Create an internet connection
lRet = InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If bOverwriteExisting Then
If Len(Dir$(sSaveToFile)) Then
VBA.Kill sSaveToFile
End If
End If
'Check file doesn't already exist
If Len(Dir$(sSaveToFile)) = 0 Then
'Download file
lRet = URLDownloadToFile(0&, sURLFileName, sSaveToFile, 0&, 0)
If Len(Dir$(sSaveToFile)) Then
'File successfully downloaded
InternetGetFile = True
Else
'Failed to download file
If lRet = E_OUTOFMEMORY Then
Debug.Print "The buffer length is invalid or there was insufficient memory to complete the operation."
Else
Debug.Assert False
Debug.Print "Error occurred " & lRet & " (this is probably a proxy server error)."
End If
InternetGetFile = False
End If
End If
On Error GoTo 0
End Function
Sub Download_and_Unzip()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim Fname1$
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Const ecbURL = "http://www.ecb.int/stats/money/yc/data/fmd/download/yc_latest.zip?"
Fname = ThisWorkbook.Path & "\yc_latest.zip"
Fname1$ = Fname
If Not InternetGetFile(ecbURL, Fname1$, True) Then
MsgBox "Failed to download file!"
Exit Sub
End If
On Error Resume Next
Kill ThisWorkbook.Path & "\yc_latest.csv"
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(ThisWorkbook.Path).CopyHere oApp.Namespace(Fname).items
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End Sub
Sub Extract_from_Csv()
Const cerca = "Yields - All euro area central government bonds - Spot rate"
Dim eu_gov_spot_rate As Single
Dim i As Integer, filenumber As Integer
Dim a$
filenumber = FreeFile
Open ThisWorkbook.Path & "\yc_latest.csv" For Input As #filenumber
i = 1
Do While Not EOF(filenumber)
Input #filenumber, a$
If InStr(1, a$, cerca) > 0 Then
For i = 2 To 359
Input #filenumber, a$, a$, eu_gov_spot_rate
Worksheets("Foglio1").Cells(i, 9) = eu_gov_spot_rate / 100
Next i
Exit Do
End If
Loop
Close #filenumber
End Sub