Récupérer la météo d'une ville

Invité · 06/01/2019, 19h23

Bonjour à tous,

Je vous présente une solution pour obtenir gratuitement la météo d'une ou plusieurs ville du monde avec un maximum de 60 requêtes / minute !

Le principe est de s'appuyer sur l'API proposée par https://openweathermap.org pour récupérer dans une structure les informations météo.
Il est possible aussi d'afficher un widget météo dans un contrôle du navigateur web (voir le site).

1ère étape : S'inscrire gratuitement sur le site pour obtenir son API Key personnelle (FREE), indispensable pour utiliser l'API, générer les widgets,...

La structure des données retournée par la fonction getMeteo :
Les données sont soit typées ou soit pratiquement toutes renvoyées au format texte dans la variable parse

Remarques :
-> Les dates et heures sont celles de Greenwich (UTC), voir plus bas pour les adapter à la date et heure locale
-> la valeur de précipitation n'est pas systématiquement retournée par le site
-> Code libre de droit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
 
Public Type tMeteo
    isErreur As Boolean    'vrai si erreur
    Erreur As String    'texte de l'erreur
    PaysCode As String    'retourne le code pays pour vérification
    VilleId As Long    'Id de la ville
    VilleNom As String    'retourne le nom de la ville(~) pour vérification
    VilleLongitude As Double    'retourne la longitude de la commune
    VilleLatitude As Double    'retourne la latitude de la commune
    UpdateUTCDate As Date    'date de la dernière mise à jour
    UpdateUTCHeure As Date    'heure de la dernière mise à jour
    LeverSoleilUTCDate As Date    'date lever du soleil
    LeverSoleilUTCHeure As Date    'heure lever du soleil
    CoucherSoleilUTCDate As Date    'date coucher du soleil
    CoucherSoleilUTCHeure As Date    'heure coucher du soleil
    TemperatureActuelle As Single    'temperature en °C car units=metric
    TemperatureActuelleMini As Single    'temperature actuelle mini
    TemperatureActuelleMaxi As Single    'temperature actuelle maxi
    Humidite As Byte    'taux d'humidité en %
    Pression As Integer    'pression atmospherique
    PressionUnite As String    'unité de pression
    VentVitesse As Single    'vitesse du vent en m/s
    VentName As String    'en anglais : Description de la force du vent
    VentDirection As Integer    '180 = sud - 360 = Nord
    Nebulosite As Integer    '% couverture nuageuse
    NebulositeName As String    'en anglais : Nom de la couverture nuageuse
    Visibilite As Long    'Visibilite en mètre
    Precipitation As Integer    'précipitation en mm si le relevé existe...
    PrecipitationName As String    'en anglais : no, rain, snow
    MeteoName As String    'Nom de la météo en anglais
    MeteoIcone As String    'Nom de l'icone correspondant
    parse As String 'toutes les infos en texte
End Type
 
Public Function getMeteo(ByVal APIkey As String, _
                         Optional ByVal VilleNom As String, _
                         Optional ByVal CodePostal As String, _
                         Optional ByVal Longitude As Double = 999, _
                         Optional ByVal Latitude As Double = 99, _
                         Optional ByVal VilleId As Long = 0, _
                         Optional ByVal PaysCode As String = "Fr" _
                         ) As tMeteo
'get météo - v1.0 - janv 2019
    On Error GoTo Erreur
    Const cBaseURL As String = "https://api.openweathermap.org/data/2.5/weather?"
    Const cConfigURL As String = "&mode=xml&units=metric&APPID="
    Dim oHttp As Object, oXml As Object, oNode As Object, URL As String, dt As Date
 
    PaysCode = Trim$(PaysCode)
    If Trim$(VilleNom) <> vbNullString Then
        URL = cBaseURL & "q=" & Trim$(VilleNom): If PaysCode <> vbNullString Then URL = URL & "," & PaysCode
    ElseIf Trim$(CodePostal) <> vbNullString Then
        URL = cBaseURL & "zip=" & Trim$(CodePostal): If PaysCode <> vbNullString Then URL = URL & "," & PaysCode
    ElseIf Abs(Longitude) <= 180# And Abs(Latitude) <= 90# Then
        URL = cBaseURL & "lat=" & Trim$(Str(Latitude)) & "&lon=" & Trim$(Str(Longitude))
    ElseIf VilleId > 0 Then
        URL = cBaseURL & "id=" & VilleId
    End If
 
    If URL <> vbNullString And Trim$(APIkey) <> vbNullString Then
        URL = URL & cConfigURL & Trim$(APIkey)
 
        Set oHttp = CreateObject("MSXML2.XMLHTTP")
        oHttp.Open "POST", URL, False
        oHttp.send
 
        If oHttp.Status = 200 Then
            Set oXml = oHttp.responseXML
            If oXml.parseError.errorCode = 0 Then
                With getMeteo
                    Set oNode = oXml.selectSingleNode("//city")
                    .VilleId = Val(oNode.Attributes.getNamedItem("id").text)
                    .VilleNom = oNode.Attributes.getNamedItem("name").text
 
                    Set oNode = oXml.selectSingleNode("//city/coord")
                    .VilleLongitude = Val(oNode.Attributes.getNamedItem("lon").text)
                    .VilleLatitude = Val(oNode.Attributes.getNamedItem("lat").text)
 
                    Set oNode = oXml.selectSingleNode("//city/country")
                    .PaysCode = oNode.text
 
                    Set oNode = oXml.selectSingleNode("//city/sun")
                    dt = CDate(Replace(oNode.Attributes.getNamedItem("rise").text, "T", " "))
                    .LeverSoleilUTCDate = DateValue(dt)
                    .LeverSoleilUTCHeure = TimeValue(dt)
 
 
                    dt = CDate(Replace(oNode.Attributes.getNamedItem("set").text, "T", " "))
                    .CoucherSoleilUTCDate = DateValue(dt)
                    .CoucherSoleilUTCHeure = TimeValue(dt)
 
                    Set oNode = oXml.selectSingleNode("//temperature")
                    .TemperatureActuelle = Val(oNode.Attributes.getNamedItem("value").text)
                    .TemperatureActuelleMini = Val(oNode.Attributes.getNamedItem("min").text)
                    .TemperatureActuelleMaxi = Val(oNode.Attributes.getNamedItem("max").text)
 
                    Set oNode = oXml.selectSingleNode("//humidity")
                    .Humidite = Val(oNode.Attributes.getNamedItem("value").text)
 
                    Set oNode = oXml.selectSingleNode("//pressure")
                    .Pression = Val(oNode.Attributes.getNamedItem("value").text)
                    .PressionUnite = oNode.Attributes.getNamedItem("unit").text
 
                    Set oNode = oXml.selectSingleNode("//wind/speed")
                    .VentVitesse = Val(oNode.Attributes.getNamedItem("value").text)
                    .VentName = oNode.Attributes.getNamedItem("name").text
 
                    Set oNode = oXml.selectSingleNode("//wind/direction")
                    .VentDirection = Val(oNode.Attributes.getNamedItem("value").text)
 
                    Set oNode = oXml.selectSingleNode("//clouds")
                    .Nebulosite = Val(oNode.Attributes.getNamedItem("value").text)
                    .NebulositeName = oNode.Attributes.getNamedItem("name").text
 
                    Set oNode = oXml.selectSingleNode("//visibility")
                    .Visibilite = Val(oNode.Attributes.getNamedItem("value").text)
 
                    Set oNode = oXml.selectSingleNode("//precipitation")
                    If oNode.Attributes.length > 1 Then .Precipitation = Val(oNode.Attributes.getNamedItem("value").text)
                    .PrecipitationName = oNode.Attributes.getNamedItem("mode").text
 
                    Set oNode = oXml.selectSingleNode("//weather")
                    .MeteoName = oNode.Attributes.getNamedItem("value").text
                    .MeteoIcone = oNode.Attributes.getNamedItem("icon").text
 
                    Set oNode = oXml.selectSingleNode("//lastupdate")
                    dt = CDate(Replace(oNode.Attributes.getNamedItem("value").text, "T", " "))
                    .UpdateUTCDate = DateValue(dt)
                    .UpdateUTCHeure = TimeValue(dt)
 
                    .parse = "VilleId=" & .VilleId & " VilleNom=" & Replace(Trim$(.VilleNom), " ", "-") & " VilleLon=" & Trim$(Str(.VilleLongitude)) & _
                             " VilleLat=" & Trim$(Str(.VilleLatitude)) & " UpdateUTCDate=" & .UpdateUTCDate & _
                             " UpdateUTCHeure=" & .UpdateUTCHeure & " LeverSoleilUTCDate=" & .LeverSoleilUTCDate & _
                             " LeverSoleilUTCHeure=" & .LeverSoleilUTCHeure & " CoucherSoleilUTCDate=" & .CoucherSoleilUTCDate & _
                             " CoucherSoleilUTCHeure=" & .CoucherSoleilUTCHeure & " TemperatureActuelle=" & .TemperatureActuelle & _
                             " TemperatureActuelleMini=" & .TemperatureActuelleMini & " TemperatureActuelleMaxi=" & .TemperatureActuelleMaxi & _
                             " Humidite=" & .Humidite & " Pression=" & .Pression & " PressionUnite=" & .PressionUnite & _
                             " VentVitesse=" & .VentVitesse & " VentDirection=" & .VentDirection & " Nebulosite=" & .Nebulosite & _
                             " Visibilite=" & .Visibilite & " PrecipitationName=" & Replace(.PrecipitationName, " ", "-") & " MeteoName=" & Replace(.MeteoName, " ", "-")
                End With
            End If
        Else
            getMeteo.isErreur = True
            getMeteo.Erreur = "oHttp.Status =" & oHttp.Status
        End If
    Else
        getMeteo.isErreur = True
        getMeteo.Erreur = "Paramètre(s) de la fonction non conforme(s)"
    End If
Fin:
    Set oNode = Nothing: Set oXml = Nothing: Set oHttp = Nothing
    Exit Function
Erreur:
    getMeteo.isErreur = True
    getMeteo.Erreur = "Erreur n°" & Err.Number & " -> " & Err.Description
    Resume Fin
End Function

Exemple d'utilisation pour afficher pratiquement toutes les infos météo d'une ville dans la fenêtre exécution de l'éditeur VBA en utilisant la variable parse de la structure:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Public Function TestMeteo()
Const cMonAPIKey As String = "123ABC456DEF..."
Dim MaMeteo As tMeteo
 
MaMeteo = getMeteo(cMonAPIKey, VilleNom:="vesoul")
 
If MaMeteo.isErreur Then
   Debug.Print MaMeteo.Erreur
Else
   Debug.Print Replace(MaMeteo.parse, " ", vbCrLf)
End If
End Function

Affichage suivant ce modèle dans la fenêtre Exécution (Ctrl+G) de l'éditeur VBA :

VilleId=2969562
VilleNom=Vesoul
VilleLon=6.16
VilleLat=47.62
UpdateUTCDate=06/01/2019
UpdateUTCHeure=17:00:00
LeverSoleilUTCDate=06/01/2019
LeverSoleilUTCHeure=07:22:55
CoucherSoleilUTCDate=06/01/2019
CoucherSoleilUTCHeure=16:00:06
TemperatureActuelle=3
TemperatureActuelleMini=3
TemperatureActuelleMaxi=3
Humidite=93
Pression=1034
PressionUnite=hPa
VentVitesse=1
VentDirection=330
Nebulosite=90
Visibilite=6000
PrecipitationName=no
MeteoName=overcast-clouds

L'API key est un paramètre obligatoire de la fonction getMeteo, il faut renseigner un seul autre paramètre suivant son choix :
soit VilleNom : Nom de la ville souhaitée
soit Code postal : 01100 par exemple
soit la longitude et latitude d'un point
soit VilleId : voir le site pour obtenir le id d'une ville
PaysCode : Par défaut "Fr" pour la France, à modifier pour d'autre pays "Ca" : canada,... ou vide mais plus de filtre

Pour aller plus loin :
la variable MeteoIcone de la structure porte le nom de l'icone météo, icone téléchargeable par la fonction suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
'download l'icone de la meteo
Public Function getMeteoIcone(ByVal MeteoIcone As String, ByVal Destination As String) As Boolean
   getMeteoIcone = DownloadHTTP("http://openweathermap.org/img/w/" & MeteoIcone & ".png", Destination)
End Function
 
'Voir tutoriel d'arkham46
Private Function DownloadHTTP(ByVal URL As String, ByVal Destination As String) As Boolean
   On Error GoTo catch
   Dim oWinHTTP As Object
   Dim fic As Integer
   Dim buffer() As Byte
 
   Set oWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
   oWinHTTP.Open "GET", URL, False
   oWinHTTP.send
 
   If oWinHTTP.Status = 200 Then
      fic = FreeFile
      Open Destination For Binary Lock Read Write As #fic
      buffer = oWinHTTP.responseBody
      Put #fic, , buffer
 
      Close #fic
      DownloadHTTP = True
   Else
      MsgBox "Statut retourné par le service : " & oWinHTTP.Status & vbCrLf & _
             "Description : " & oWinHTTP.statusText, vbExclamation, "DownloadHTTP()..."
   End If
 
finally:
   Erase buffer
   Set oWinHTTP = Nothing
   Exit Function
catch:
   MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description : " & Err.Description, vbExclamation, "DownloadHTTP()..."
   Close   'ferme tous les descripteurs ouverts
   Resume finally
End Function

Exemple d'utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
getMeteoIcone MaMeteo.MeteoIcone, CurrentProject.Path & "\MaMeteo.png"

Pour obtenir une valeur texte unique de la variable parse, par exemple la direction du vent :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Debug.Print getTextBetween(MaMeteo.parse, "VentDirection=")

la fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
'retourne un texte entre deux limites
Public Function getTextBetween(ByVal text As String, ByVal Before As String, Optional ByVal After = " ") As String
On Error Resume Next
getTextBetween = Split(Split(text, Before)(1), After)(0)
End Function

Pour transformer la date et heure UTC en date et heure locale, deux fonctions possibles :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
'https://docs.microsoft.com/en-us/windows/desktop/wmisdk/swbemdatetime
'https://stackoverflow.com/questions/1600875/how-to-get-the-current-datetime-in-utc-from-an-excel-vba-macro
Public Function UTCtoLocalTime1(ByVal UTCDateTime As Date) As Date
    Dim dt As Object: Set dt = CreateObject("WbemScripting.SWbemDateTime")
    dt.SetVarDate UTCDateTime, False: UTCtoLocalTime1 = dt.GetVarDate(True)
End Function
 
'https://www.excelguru.ca/forums/archive/index.php/t-6835.html
Public Function UTCtoLocalTime2(ByVal UTCDateTime As Date) As Date
    Dim Mn As Integer: Mn = Val(CreateObject("wscript.shell").regRead("HKLM\system\currentcontrolset\control\timezoneinformation\bias"))
    UTCtoLocalTime2 = DateAdd("n", -Mn, UTCDateTime)
End Function

Exemple d'utilisation pour transformer les heures :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Debug.Print UTCtoLocalTime1(MaMeteo.LeverSoleilUTCDate + MaMeteo.LeverSoleilUTCHeure)

Bonne météo !

**f-leb** · 06/01/2019, 19h59

Salut Galoir,

Voilà une très bonne idée que cette contribution

J'ai déjà utilisé l'API d'openWeatherMap, c'était en Python et en JSON mais je suis ravi de voir une contribution avec cette API sous Access.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MaMeteo = getMeteo(cMonAPIKey, VilleNom:="vesoul")

Dans la base de données, il y a deux stations avec "vesoul" comme "name" (et même une 3e avec "Arrondissement de Vesoul"), et c'est pour ça que la doc recommande plutôt d'utiliser l'identifiant "id" de la station.

Je n'ai pas creusé plus loin l'API, mais je sais qu'on peut récupérer des widgets que l'on pourrait insérer dans un formulaire par exemple, ainsi que des cartes de température, pression, etc.

Il y a de quoi faire avec cette API, mais beau boulot déjà

Invité · 06/01/2019, 20h34

Merci f-leb pour ton message,

j'avais les briques (tutos arkham46 x 2, etc...), un peu de liant et hop

Amicalement

Invité · 08/01/2019, 13h14

En complément, deux fichiers .csv zippés de plus de 200 000 stations météo avec leur StationId (<=> à VilleId en paramètre de getMeteo) + Nom, Code pays (France = FR), longitude, latitude.

**nico84** · 11/01/2019, 13h08

Merci pour ce code, je mets de coté au cas où

Je ne sais pas qui s'occupe de ça mais ce serait bien que ce type de code alimente l'onglet "sources" du site

**User** · 15/01/2019, 20h45

Bonjour et bravo pour cette contribution

Envoyé par nico84

Merci pour ce code, je mets de coté au cas où

Je ne sais pas qui s'occupe de ça mais ce serait bien que ce type de code alimente l'onglet "sources" du site

J'ai fait la demande mais apparemment ça semble un peu compliqué de rajouter une entrée avec la page actuelle de sources (ancienne méthode), "c'est un peu galère" m'est c'est noté.

Merci encore !

Récupérer la météo d'une ville

Contribuez

Discussions similaires

Partager

Partager