Excel web scraping VBA

**Raziel68** · 09/06/2022, 12h10

Bonjour à tous !

Dans un premier temps je suis très heureux d'intégrer ce forum !

Pour me présenter, je suis développeur en Pascal sur un ERP fonctionnant sous UNIX depuis de nombreuses années.
Je développe également en Visual Basic afin d'apporter du support aux utilisateurs de mon entreprise en utilisant Excel.

Dernièrement j'ai reçu une demande d'un utilisateur, celui ci effectue un travail chronophage et je souhaite le soulager dans ses tâches.

Il se connecte sur le site d'une compagnie maritime : https://www.maersk.com/tracking/
Il rentre des informations pour le tracking et souhaite récupérer des information, un exemple concret : https://www.maersk.com/tracking/TCNU8645167

Il souhaite récupérer des informations afin de savoir si le navire est arrivé.
J'ai entendu parlé du technologie le web scraping en python. Cette solution existe apparemment en Visual basic via Excel.

Ma question, avez vous déjà utilisé ce process via Excel afin d'a partir d'une liste récupérer les informations?
Si jamais une personne dispose d'un exemple sur lequel je puisse m'appuyer afin de l'adapter je suis vraiment preneur.

Un grand merci par avance pour vos éclaircissements sur ce sujet !!!

**Qwazerty** · 09/06/2022, 23h39

Salut

Il existe plusieurs approches

A partir de VBA
- En utilisant Selenium
- En utilisant IE (mais qui devient obsolète) - Voir mon tuto dans ma signature
- En faisant des requêtes HTTP
A partir de Power Query

S'agissant d'IE, je pense que c'est mort, déjà parce qu'il est obsolète et de plus le contenu de la page fait référence à un iframe, ce qui est souvent un problème.

S'agissant de Selenium, je ne l'ai jamais essayé.

S'agissant des requête à partir de VBA, ça devrait fonctionner. Par contre tu vas te retrouver avec un Json. J'ai trouvé un code qui crée une arborescence à l'aide de collection et de dictionary... mais j'ai trouvé ça plutôt lourd à utiliser...

En regardant le code de la page, j'ai vu que le site utilise un système d'API via requête HTTP. La réponse retournée est en Json.
Je t'orienterais donc plutôt sur la dernière option, Power Query, je l'ai fait ce matin pour la 1ère fois sur un projet boulot (en remplacement des collection/dictionary), je ne sais pas ce que ça va donner avec ce JSon mais pour ma part j'étais aux anges...
Après il faut que ta version d'excel soit au moins égale à 2019 (il me semble) pour avoir PQ.

Voila les infos utiles:

Dans Excel, onglet Données, tu crées une "nouvelle requête" web (A partir d'autres sources -> A partir du Web)
En mode Avancé, tu pourras lui transmettre les renseignements piqués ici
Nom : Entête.jpg
Affichages : 1065
Taille : 88,4 Ko

Nom : Entête.jpg
Affichages : 1065
Taille : 88,4 Ko

L'URL de base étant en deux parties
https://www.maersk.com/tracking/
TCNU8645167

Ou peut-être en 3 parties
api.maersk.com\
TCNU8645167
?Operator=MAEU

Ensuite, dans PQ, il faudra un peu naviguer dans les tables Json pour trouver les renseignements visible ici sur l'explorateur de page web
Nom : Response.jpg
Affichages : 1051
Taille : 732,9 Ko

Nom : Response.jpg
Affichages : 1051
Taille : 732,9 Ko

Une fois que le processus PQ est établi, il faudra juste mettre quelques parties en paramètre (le numéro du colis essentiellement) et ça devrait rouler.
Il est tard, si tu n'as pas de résultat d'ici demain soir, je regarderais, je débute sur PQ, toutes les expériences sont bonnes à prendre

++
Qwaz

**Qwazerty** · 10/06/2022, 08h05

Salut

C'est curieux, j'ai le même problème que pour mon projet perso, il y a un problème que je ne comprends pas par rapport au Host. Sauf que dans mon cas, il m'a suffit de supprimer le Host de l'entête et tout à fonctionné... mais pas dans le cas du site que tu utilises.

J'ai fait un essai avec un requête en VBA et là pas de soucis, donc j'imagine que c'est PQ qui doit posait problème.

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
Sub Req_FermerContact()
'Il faut activer la bibliothèque Microsoft WinHTTP Service et M$ MSXML
Dim DemandeFichier As MSXML2.XMLHTTP60, URL As String
Dim strRetour As String
 
 
    'On instancie
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP")
 
    'On définie l'URL
    URL = "https://api.maersk.com/track/TCNU8645167?operator=MAEU"
 
    'On génère la requête
    DemandeFichier.Open "GET", URL, False
    DemandeFichier.setRequestHeader "Host", "api.maersk.com"
    DemandeFichier.setRequestHeader "Accept", "application/json"
    DemandeFichier.setRequestHeader "Accept-Encoding", "gzip, deflate, br"
    DemandeFichier.setRequestHeader "Content-Type", "application/json"
    DemandeFichier.setRequestHeader "Accept-Language", "fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3"
    DemandeFichier.setRequestHeader "Referer", "https://www.maersk.com/"
    DemandeFichier.setRequestHeader "Origin", "https://www.maersk.com/"
 
    'On envoie la requete
    DemandeFichier.send
 
    'On place les données reçues en retour dans une cellule
    Feuil1.Range("A1").Value = DemandeFichier.ResponseText
  End Sub

Le problème avec cette méthode, comme je l'indiquais en haut, c'est que tu te retrouve avec un JSon que VBA ne gère pas en natif, il faut l'interpréter. En regardant sur le web tu trouvera vite un interpréteur Json qui utilise Collection/Dictionnary pour reproduire l'arborescence mais le mieux serait quand même PowerQuerry...

++
Qwaz

**jurassic pork** · 10/06/2022, 14h29

hello,
Sniff !

je n'arrive pas à me connecter à cette adresse "https://api.maersk.com/track/TCNU8645167?operator=MAEU" en utilisant Le Power Query d'Excel 2019 (timeout de connexion)
. Par contre en utilisant du VBA cela fonctionne. En utilisant un module "Parser Json" on arrive à récupérer toutes les informations qui sont renvoyées :
1 - Code de Récupération :

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
Sub Req_SuiviLivraison()
Dim DemandeFichier As Object
Dim dic As Object
Dim URL As String
Dim strRetour As String
    Set DemandeFichier = CreateObject("Microsoft.XMLHTTP") 
    'On définie l'URL
    URL = "https://api.maersk.com/track/TCNU8645167?operator=MAEU" 
    'On génère la requête
    DemandeFichier.Open "GET", URL, False
    'On envoie la requete
    DemandeFichier.send
    strRetour = DemandeFichier.responseText
    Set dic = ParseJSON(strRetour)
    Debug.Print ListPaths(dic)
    Debug.Print dic("obj.containers(0).eta_final_delivery")
  End Sub

Avec le module VBA JsonParser qui contient ce code :

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
'-------------------------------------------------------------------
' VBA JSON Parser
'-------------------------------------------------------------------
Option Explicit
Private p&, token, dic
Function ParseJSON(json$, Optional key$ = "obj") As Object
    p = 1
    token = Tokenize(json)
    Set dic = CreateObject("Scripting.Dictionary")
    If token(p) = "{" Then ParseObj key Else ParseArr key
    Set ParseJSON = dic
End Function
Function ParseObj(key$)
    Do: p = p + 1
        Select Case token(p)
            Case "]"
            Case "[":  ParseArr key
            Case "{"
                       If token(p + 1) = "}" Then
                           p = p + 1
                           dic.Add key, "null"
                       Else
                           ParseObj key
                       End If
 
            Case "}":  key = ReducePath(key): Exit Do
            Case ":":  key = key & "." & token(p - 1)
            Case ",":  key = ReducePath(key)
            Case Else: If token(p + 1) <> ":" Then dic.Add key, token(p)
        End Select
    Loop
End Function
Function ParseArr(key$)
    Dim e&
    Do: p = p + 1
        Select Case token(p)
            Case "}"
            Case "{":  ParseObj key & ArrayID(e)
            Case "[":  ParseArr key
            Case "]":  Exit Do
            Case ":":  key = key & ArrayID(e)
            Case ",":  e = e + 1
            Case Else: dic.Add key & ArrayID(e), token(p)
        End Select
    Loop
End Function
'-------------------------------------------------------------------
' Support Functions
'-------------------------------------------------------------------
Function Tokenize(s$)
    Const Pattern = """(([^""\\]|\\.)*)""|[+\-]?(?:0|[1-9]\d*)(?:\.\d*)?(?:[eE][+\-]?\d+)?|\w+|[^\s""']+?"
    Tokenize = RExtract(s, Pattern, True)
End Function
Function RExtract(s$, Pattern, Optional bGroup1Bias As Boolean, Optional bGlobal As Boolean = True)
  Dim c&, m, n, v
  With CreateObject("vbscript.regexp")
    .Global = bGlobal
    .MultiLine = False
    .IgnoreCase = True
    .Pattern = Pattern
    If .test(s) Then
      Set m = .Execute(s)
      ReDim v(1 To m.Count)
      For Each n In m
        c = c + 1
        v(c) = n.Value
        If bGroup1Bias Then If Len(n.SubMatches(0)) Or n.Value = """""" Then v(c) = n.SubMatches(0)
      Next
    End If
  End With
  RExtract = v
End Function
Function ArrayID$(e)
    ArrayID = "(" & e & ")"
End Function
Function ReducePath$(key$)
    If InStr(key, ".") Then ReducePath = Left(key, InStrRev(key, ".") - 1) Else ReducePath = key
End Function
Function ListPaths(dic)
    Dim s$, v
    For Each v In dic
        s = s & v & " --> " & dic(v) & vbLf
    Next
    Debug.Print s
End Function
Function GetFilteredValues(dic, match)
    Dim c&, i&, v, w
    v = dic.keys
    ReDim w(1 To dic.Count)
    For i = 0 To UBound(v)
        If v(i) Like match Then
            c = c + 1
            w(c) = dic(v(i))
        End If
    Next
    ReDim Preserve w(1 To c)
    GetFilteredValues = w
End Function
Function GetFilteredTable(dic, cols)
    Dim c&, i&, j&, v, w, z
    v = dic.keys
    z = GetFilteredValues(dic, cols(0))
    ReDim w(1 To UBound(z), 1 To UBound(cols) + 1)
    For j = 1 To UBound(cols) + 1
         z = GetFilteredValues(dic, cols(j - 1))
         For i = 1 To UBound(z)
            w(i, j) = z(i)
         Next
    Next
    GetFilteredTable = w
End Function
Function OpenTextFile$(f)
    With CreateObject("ADODB.Stream")
        .Charset = "utf-8"
        .Open
        .LoadFromFile f
        OpenTextFile = .ReadText
    End With
End Function

J'obtiens ceci pour le Debug.Print ListPaths(dic) :

obj.isContainerSearch --> true
obj.origin.terminal --> Beijiao Terminal
obj.origin.geo_site --> 9WMY14WIIBJF2
obj.origin.city --> Beijiao
obj.origin.state --> Guangdong
obj.origin.country --> China
obj.origin.country_code --> CN
obj.origin.geoid_city --> 348EMR71GNL32
obj.origin.site_type --> BARGE TERMINAL
obj.destination.terminal --> Seayard 2XL
obj.destination.geo_site --> KYKBROU8A0XZB
obj.destination.city --> Fos sur Mer
obj.destination.state --> Bouches-du-Rhone
obj.destination.country --> France
obj.destination.country_code --> FR
obj.destination.geoid_city --> 18CL185ZO5EVT
obj.destination.site_type --> TERMINAL
obj.containers(0).container_num --> TCNU8645167
obj.containers(0).container_size --> 40
obj.containers(0).container_type --> Dry
obj.containers(0).iso_code --> 42G0
obj.containers(0).operator --> MAEU
obj.containers(0).locations(0).terminal --> Beijiao Terminal
obj.containers(0).locations(0).geo_site --> 9WMY14WIIBJF2
obj.containers(0).locations(0).city --> Beijiao
obj.containers(0).locations(0).state --> Guangdong
obj.containers(0).locations(0).country --> China
obj.containers(0).locations(0).country_code --> CN
obj.containers(0).locations(0).geoid_city --> 348EMR71GNL32
obj.containers(0).locations(0).site_type --> BARGE TERMINAL
obj.containers(0).locations(0).events(0).activity --> GATE-OUT-EMPTY
obj.containers(0).locations(0).events(0).stempty --> true
obj.containers(0).locations(0).events(0).actfor --> EXP
obj.containers(0).locations(0).events(0).vessel_name --> DUMMY BARGE
obj.containers(0).locations(0).events(0).voyage_num --> 1234
obj.containers(0).locations(0).events(0).vessel_num --> 3OF
obj.containers(0).locations(0).events(0).expected_time --> 2022-04-23T00:00:00.000
obj.containers(0).locations(0).events(0).actual_time --> 2022-04-06T14:00:00.000
obj.containers(0).locations(0).events(0).rkem_move --> GATE-OUT
obj.containers(0).locations(0).events(0).is_cancelled --> false
obj.containers(0).locations(0).events(0).is_current --> false
obj.containers(0).locations(0).events(1).activity --> GATE-IN
obj.containers(0).locations(0).events(1).stempty --> false
obj.containers(0).locations(0).events(1).actfor --> EXP
obj.containers(0).locations(0).events(1).vessel_name --> DUMMY BARGE
obj.containers(0).locations(0).events(1).voyage_num --> 1234
obj.containers(0).locations(0).events(1).vessel_num --> 3OF
obj.containers(0).locations(0).events(1).expected_time --> 2022-04-23T00:00:00.000
obj.containers(0).locations(0).events(1).actual_time --> 2022-04-08T14:00:00.000
obj.containers(0).locations(0).events(1).rkem_move --> GATE-IN
obj.containers(0).locations(0).events(1).is_cancelled --> false
obj.containers(0).locations(0).events(1).is_current --> false
obj.containers(0).locations(0).events(2).activity --> LOAD
obj.containers(0).locations(0).events(2).stempty --> false
obj.containers(0).locations(0).events(2).actfor -->
obj.containers(0).locations(0).events(2).vessel_name --> LI ZHOU 318
obj.containers(0).locations(0).events(2).voyage_num --> 2163
obj.containers(0).locations(0).events(2).vessel_num --> LKO
obj.containers(0).locations(0).events(2).expected_time --> 2022-04-23T00:00:00.000
obj.containers(0).locations(0).events(2).actual_time --> 2022-04-21T20:15:00.000
obj.containers(0).locations(0).events(2).rkem_move --> LOAD
obj.containers(0).locations(0).events(2).is_cancelled --> false
obj.containers(0).locations(0).events(2).is_current --> false
obj.containers(0).locations(1).terminal --> GZ Oceangate Container Terminal
obj.containers(0).locations(1).geo_site --> 2PC5CM50UQSE2
obj.containers(0).locations(1).city --> Nansha New Port
obj.containers(0).locations(1).state --> Guangdong
obj.containers(0).locations(1).country --> China
obj.containers(0).locations(1).country_code --> CN
obj.containers(0).locations(1).geoid_city --> 06AZ2N3T2FBMH
obj.containers(0).locations(1).site_type --> TERMINAL
obj.containers(0).locations(1).events(0).activity --> DISCHARG
obj.containers(0).locations(1).events(0).stempty --> false
obj.containers(0).locations(1).events(0).actfor -->
obj.containers(0).locations(1).events(0).vessel_name --> LI ZHOU 318
obj.containers(0).locations(1).events(0).voyage_num --> 2163
obj.containers(0).locations(1).events(0).vessel_num --> LKO
obj.containers(0).locations(1).events(0).expected_time --> 2022-04-24T00:00:00.000
obj.containers(0).locations(1).events(0).actual_time --> 2022-04-22T08:02:00.000
obj.containers(0).locations(1).events(0).rkem_move --> DISCHARG
obj.containers(0).locations(1).events(0).is_cancelled --> false
obj.containers(0).locations(1).events(0).is_current --> false
obj.containers(0).locations(1).events(1).activity --> LOAD
obj.containers(0).locations(1).events(1).stempty --> false
obj.containers(0).locations(1).events(1).actfor -->
obj.containers(0).locations(1).events(1).vessel_name --> MSC FEBE
obj.containers(0).locations(1).events(1).voyage_num --> 215W
obj.containers(0).locations(1).events(1).vessel_num --> Q5S
obj.containers(0).locations(1).events(1).expected_time --> 2022-05-01T16:00:00.000
obj.containers(0).locations(1).events(1).actual_time --> 2022-05-01T02:20:00.000
obj.containers(0).locations(1).events(1).rkem_move --> LOAD
obj.containers(0).locations(1).events(1).is_cancelled --> false
obj.containers(0).locations(1).events(1).is_current --> false
obj.containers(0).locations(2).terminal --> BEST Terminal Catalunya
obj.containers(0).locations(2).geo_site --> K8TAIS4Q1YQBU
obj.containers(0).locations(2).city --> Barcelona
obj.containers(0).locations(2).state -->
obj.containers(0).locations(2).country --> Spain
obj.containers(0).locations(2).country_code --> ES
obj.containers(0).locations(2).geoid_city --> 1FQMCYMU9XLZ2
obj.containers(0).locations(2).site_type --> TERMINAL
obj.containers(0).locations(2).events(0).activity --> DISCHARG
obj.containers(0).locations(2).events(0).stempty --> false
obj.containers(0).locations(2).events(0).actfor -->
obj.containers(0).locations(2).events(0).vessel_name --> MSC FEBE
obj.containers(0).locations(2).events(0).voyage_num --> 215W
obj.containers(0).locations(2).events(0).vessel_num --> Q5S
obj.containers(0).locations(2).events(0).expected_time --> 2022-06-03T14:00:00.000
obj.containers(0).locations(2).events(0).actual_time --> 2022-06-05T04:33:00.000
obj.containers(0).locations(2).events(0).rkem_move --> DISCHARG
obj.containers(0).locations(2).events(0).is_cancelled --> false
obj.containers(0).locations(2).events(0).is_current --> true
obj.containers(0).locations(2).events(1).activity --> LOAD
obj.containers(0).locations(2).events(1).stempty --> false
obj.containers(0).locations(2).events(1).actfor --> EXP
obj.containers(0).locations(2).events(1).vessel_name --> MACAO
obj.containers(0).locations(2).events(1).voyage_num --> 222N
obj.containers(0).locations(2).events(1).vessel_num --> T9H
obj.containers(0).locations(2).events(1).expected_time --> 2022-06-12T06:01:00.000
obj.containers(0).locations(2).events(1).is_current --> false
obj.containers(0).locations(3).terminal --> Seayard 2XL
obj.containers(0).locations(3).geo_site --> KYKBROU8A0XZB
obj.containers(0).locations(3).city --> Fos sur Mer
obj.containers(0).locations(3).state --> Bouches-du-Rhone
obj.containers(0).locations(3).country --> France
obj.containers(0).locations(3).country_code --> FR
obj.containers(0).locations(3).geoid_city --> 18CL185ZO5EVT
obj.containers(0).locations(3).site_type --> TERMINAL
obj.containers(0).locations(3).events(0).activity --> DISCHARG
obj.containers(0).locations(3).events(0).stempty --> false
obj.containers(0).locations(3).events(0).actfor --> EXP
obj.containers(0).locations(3).events(0).vessel_name --> MACAO
obj.containers(0).locations(3).events(0).voyage_num --> 222N
obj.containers(0).locations(3).events(0).vessel_num --> T9H
obj.containers(0).locations(3).events(0).expected_time --> 2022-06-12T20:00:00.000
obj.containers(0).locations(3).events(0).is_current --> false
obj.containers(0).locations(3).events(1).activity --> GATE-OUT
obj.containers(0).locations(3).events(1).stempty --> false
obj.containers(0).locations(3).events(1).actfor --> DEL
obj.containers(0).locations(3).events(1).vessel_name --> MACAO
obj.containers(0).locations(3).events(1).voyage_num --> 222N
obj.containers(0).locations(3).events(1).vessel_num --> T9H
obj.containers(0).locations(3).events(1).expected_time --> 2022-06-12T20:00:00.000
obj.containers(0).locations(3).events(1).is_current --> false
obj.containers(0).eta_final_delivery --> 2022-06-12T20:00:00.000
obj.containers(0).latest.actual_time --> 2022-06-05T04:33:00.000
obj.containers(0).latest.activity --> DISCHARG
obj.containers(0).latest.stempty --> false
obj.containers(0).latest.actfor -->
obj.containers(0).latest.geo_site --> K8TAIS4Q1YQBU
obj.containers(0).latest.city --> Barcelona
obj.containers(0).latest.state -->
obj.containers(0).latest.country --> Spain
obj.containers(0).latest.country_code --> ES
obj.containers(0).status --> IN-PROGRESS

et pour le Debug.Print dic("obj.containers(0).eta_final_delivery") :

2022-06-12T20:00:00.000

Quelle est l'info recherchée exactement ?

[EDIT] Le conteneur ne doit pas être encore arrivé --> status --> IN-PROGRESS

Ami calmant, J.P

**Raziel68** · 21/06/2022, 15h50

Alors déjà un immense Merci à a vous deux : Qwazerty jurassic pork.

Je viens juste de rentrer de déplacement pro et j'avoue être un peu érinter par cette chaleur.
Je vais déjà lire attentivement vos réponses et je n'hésiterai pas à vous répondre et à commenter le post.

**jurassic pork** · 22/06/2022, 07h41

hello,

Envoyé par jurassic pork

Le conteneur ne doit pas être encore arrivé --> status --> IN-PROGRESS

Le conteneur est finalement arrivé --> status --> COMPLETE
Avec un code comme celui-ci tu devrais pouvoir savoir si le conteneur est arrivé :

Code :

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

1
2
3
4
5
6
Debug.Print "============================================="
If dic("obj.containers(0).status") = "COMPLETE" Then
      Debug.Print "Le conteneur est arrivé"
      Debug.Print "Date et Heure : " + dic("obj.containers(0).latest.actual_time")
      Debug.Print "Lieu : " + dic("obj.containers(0).latest.city")
End If