1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Private Declare Function TelechargerFichierURL 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 Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Public Function TelechargerFichierInternet(SourceUrl As String, FichierLocal As String) As Boolean
TelechargerFichierInternet = TelechargerFichierURL(0&, SourceUrl, FichierLocal, BINDF_GETNEWESTVERSION, 0&) = ERROR_SUCCESS
End Function
Public Function URLexiste(URLaVerifier As String) As Boolean
'par Excel-Malin.com ( https://excel-malin.com )
On Error GoTo Erreur
Dim oXHTTP As Object
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
oXHTTP.Open "HEAD", URLaVerifier, False
oXHTTP.Send
URLexiste = (oXHTTP.Status = 200)
Exit Function
Erreur:
URLexiste = False
End Function
Sub main()
Dim URL As String
Dim ws As Worksheet
Dim fichier As String
Dim nomFichier As String
'ici l'URL du fichier a telecharger
URL = "http://webstat.banque-france.fr/fr/downloadFile.do?id=5385698&exportTypecsv"
'ici le nom du fichier enregistré
nomFichier = "TauxdeChange.csv"
'ici le chemin d'enregistrement du fichier en local
fichier = "C:\Users\bboschi\Documents\taux Change\" & nomFichier
'verification existance lien
If URLexiste(URL) = False Then GoTo fin
'appel a la fonction avec les arguments requis
TelechargerFichierInternet URL, fichier
'définition de la feuille hote
Set ws = Feuil1
'chargement du fichier csv dans la feuille avec l'outil querytables
With ws.QueryTables.Add(Connection:="TEXT;" & fichier, Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileSemicolonDelimiter = True
.Refresh
End With
GoTo fin
Err:
'si le lien est erroné
MsgBox "fichier web introuvable, veuillez vérifier le lien : " & URL, vbCritical, "Erreur lien fichier"
fin:
End Sub |
Partager