Récupérer des données sur internet et les integrer dans un ficher Excel

**dodinouche** · 28/07/2015, 19h13

Bonjour à tous,

Voila dans le cadre d'un de mes projet je voudrais pouvoir extraire des données d'internet pour les intégrer dans un fichier excel.

Mon url est celui ci : http://aguila-bidart.fr/demo/ISSY/we...e.php?ndDay=31

Je souhaiterai que les informations contenue sur cette URL soit intégrer dans un ficher Excel en passant par une macro pour l'automatiser.

Avez vous une idée pour m'aidez s'il vous plaît ?

Merci par avance.

Clément.

**PMO2017** · 29/07/2015, 13h50

Bonjour,

Une piste avec le code suivant

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
Sub aa()
Call ExtractionData("http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31")
End Sub
 
Sub ExtractionData(URL As String)
Dim S As Worksheet
Dim IE As Object
Dim A$
Dim var
Dim i&
'---
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate (URL)
'---
Do While IE.Busy
  DoEvents
Loop
'---
A$ = IE.document.body.InnerText
If A$ = "" Then Exit Sub
'---
var = (Split(A$, "}"))
Set S = Sheets.Add
'---
For i& = LBound(var) To UBound(var)
  S.Range("a" & i& + 1 & "") = var(i&)
Next i&
'---
IE.Quit
Set IE = Nothing
End Sub

Lancez la macro "aa".

**patricktoulon** · 30/07/2015, 03h47

Bonsoir
le soucis avec ce genre de fichier que j'aparenterais a du json c'est qu'il n'est pas structuré correctement
alors quand on le recupere il tient dans une 15 ne de ligne tout acrochées

si tu veux le restituer a l'identique du fichier initial sur le web
il te faut astucer
ici encore l'exercice sera facile
prenons la 1 ere ligne en exemple

[{"value_Mesure":"0","timestamp_Mesure":"1436172169"},{"value_Mesure":"0","timestamp_Mesure":"1436179595"},{"value_Mesure":"0","timestamp_Mesure":"1436187024"},{"

il y a 6 fois mesure
3 fois timestamp
et je suppose que cse sont les mesure que tu veux récupérer et donc :
nous en trouvons 6 tiens!!!! 6 sa me rappelle quelque chose

nous allons donc couper le texte par mesure acompagné de son ":"

pour cela
split(texte,"mesure"":" & chr(34)
maintenant comme le texte obtenu par le telechargement par IE ou une requete nous le restitu pas ligne par ligne il faut les recréer
donc dans une boucle sur les mesure (coupe) on incremente une variable jusqu'a 6 puis la ramenons a zero et incrementant une seconde variable pour la ligne a chaque fois que la 1 ere ateint 6
resultat moins d'un quart de seconde
j'ai utiliser plutot une requete (plus rapide ne demandant pas de parametre )

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Dim ReQ, url,coupe,compte,lig
    url = "http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "POST", url, False
    ReQ.send
    coupe = Split(ReQ.responsetext, "Mesure"":" & Chr(34))
    lig = 1
    For i = 1 To UBound(coupe)
        compte = compte + 1
        Cells(lig, compte) = Split(coupe(i), Chr(34))(0)
        If compte = 6 Then lig = lig + 1: compte = 0
    Next
End Sub

résultat voila
Pièce jointe 184277

**dodinouche** · 30/07/2015, 09h43

Bonjour PMO2017 et Patricktoulon,

D'abord merci beaucoup pour votre aide c'est un grand début pour moi.

Pour répondre à ta question Patricktoulon, en effet les informations dans cet URL sont en vrac, moi j'aimerai avoir deux information par ligne (comme dans ta macro) mais avec seulement deux colonnes :

colonne 1 colonne 2
Ligne 1 : 0 | 1436172169
Ligne 2 : 0 | 1436179595
etc ...

Car la la macro que tu as faite, qui est très bien, mais elle met les résultats sur 6 colonnes alors que moi j’aimerai seulement avoir deux colonnes.

Je vous remercie grandement pour votre aide !

Merci par avance pour cette dernière question.

Bonne journée à vous.

**dodinouche** · 30/07/2015, 10h20

Re,

Et j'aimerai aussi rajouter pour chaque case de ce type "1436172169" la transformer avec cette formule =((("case"/60)/60)/24)+ DATE(1970;1;1)+(1/24) pour avoir une date normale qui s'affiche.

Merci pour votre aide

**PMO2017** · 30/07/2015, 10h31

colonne 1 colonne 2
Ligne 1 : 0 | 1436172169
Ligne 2 : 0 | 1436179595
etc ...

Bonjour,

Essayez avec ce nouveau 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
Sub Extraire()
Call ExtractionData("http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31")
End Sub
 
Sub ExtractionData(URL As String)
Dim S As Worksheet
Dim IE As Object
Dim A$
Dim var
Dim i&
 '---
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate (URL)
'---
Do While IE.Busy
  DoEvents
Loop
'---
A$ = IE.document.body.InnerText
'---
IE.Quit
Set IE = Nothing
 
'###########################
If A$ = "" Then Exit Sub
A$ = Replace(A$, "[", ",")
A$ = Replace(A$, "]", "")
A$ = Replace(A$, ",{" & Chr(34) & "value_Mesure" & Chr(34) & ":" & Chr(34), "")
A$ = Replace(A$, "," & Chr(34) & "timestamp_Mesure" & Chr(34) & ":" & Chr(34), "")
var = (Split(A$, "}"))
Set S = Sheets.Add
'---
For i& = LBound(var) To UBound(var)
  S.Range("a" & i& + 1 & "") = var(i&)
Next i&
'---
S.[a1].CurrentRegion.TextToColumns Destination:=Range("A1"), _
  DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
  ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
  Comma:=False, Space:=False, Other:=True, OtherChar:=""""
End Sub

Lancez la macro "Extraire".

**dodinouche** · 30/07/2015, 10h57

Re,

MERCI PMO2017 ! c'est exactement ça ! merci beaucoup !

Encore une dernière question et je ne t’embête plus.. Saurait tu comment transformer directement dans la macro les éléments "timestamp_Mesure" qui sont actuellement de ce style "1436172169" en ce style la (13/03/2015 08:45) grâce à la formule suivante : =((("case"/60)/60)/24)+ DATE(1970;1;1)+(1/24).

Merci beaucoup pour ton temps !

Clément.

**patricktoulon** · 30/07/2015, 11h12

re
re avec mon code tu change 6 pour 2 c'est tout

serait ce ce resultat que tu veux

Code :

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

1
2
3
4
5
Sub test()
'1436172169
truc = (1436172169 / 60 / 60 / 24)
MsgBox CDate(truc)
End Sub

resultat
04/07/1945 08:42:49

**patricktoulon** · 30/07/2015, 11h58

c'est ce resultat que tu veux ?

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
Sub test2()
    Dim ReQ, url, coupe, compte, lig
    url = "http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "POST", url, False
    ReQ.send
    coupe = Split(ReQ.responsetext, "Mesure"":" & Chr(34))
    lig = 1
    For i = 1 To UBound(coupe)
        compte = compte + 1
        donnée = Split(coupe(i), Chr(34))(0)
       Cells(lig, compte) = IIf(compte < 2, donnée, CDate((donnée / 60 / 60 / 24)))
        If compte = 2 Then
            année = Format(Cells(lig, 2), "yyyy")
            Cells(lig, 2) = Replace(Cells(lig, 2), année, année + 70)
            lig = lig + 1: compte = 0
        End If
    Next
End Sub

Pièce jointe 184298

**PMO2017** · 30/07/2015, 12h38

Saurait tu comment transformer directement dans la macro les éléments "timestamp_Mesure" qui sont actuellement de ce style "1436172169" en ce style la (13/03/2015 08:45)

Bonjour,
Plutôt que d'écraser les valeurs de la colonne B, j'ai préféré inscrire le résultat en colonne C.
Vous pourrez ainsi vérifier si ce sont bien les résultats escomptés (???).

Le nouveau 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
Sub Extraire()
Call ExtractionData("http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31")
End Sub
 
Sub ExtractionData(URL As String)
Dim S As Worksheet
Dim R As Range
Dim R2 As Range
Dim IE As Object
Dim A$
Dim var
Dim i&
 '---
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate (URL)
'---
Do While IE.Busy
  DoEvents
Loop
'---
A$ = IE.document.body.InnerText
'---
IE.Quit
Set IE = Nothing
 
'###########################
If A$ = "" Then Exit Sub
A$ = Replace(A$, "[", ",")
A$ = Replace(A$, "]", "")
A$ = Replace(A$, ",{" & Chr(34) & "value_Mesure" & Chr(34) & ":" & Chr(34), "")
A$ = Replace(A$, "," & Chr(34) & "timestamp_Mesure" & Chr(34) & ":" & Chr(34), "")
var = (Split(A$, "}"))
Set S = Sheets.Add
'---
For i& = LBound(var) To UBound(var)
  S.Range("a" & i& + 1 & "") = var(i&)
Next i&
'---
S.[a1].CurrentRegion.TextToColumns Destination:=Range("A1"), _
  DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
  ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
  Comma:=False, Space:=False, Other:=True, OtherChar:=""""
'--- Format "dd/mm/yyyy   hh:mm:ss" ---
For i& = 1 To UBound(var)
  Set R = S.Range("b" & i& & "")
  Set R2 = R.Offset(0, 1)
  R2 = (R / 86400) + CDbl(CDate("1/1/1970") + (1 / 24))
  R2.NumberFormat = "dd/mm/yyyy   hh:mm:ss"
Next i&
End Sub

**patricktoulon** · 30/07/2015, 13h10

re
bien vu PMO pour la formule
en l'adaptant a mon principe je n'arrive pas a avoir les secondes c'est assez etonnant

pourquoi utilise tu IE pour ce genre de fichier Ie est plus lourd qu'une requete et plus long ??

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
Sub test2()
    Dim ReQ, URL, coupe, compte, lig
    URL = "http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "POST", URL, False:    ReQ.send
    coupe = Split(ReQ.responsetext, "Mesure"":" & Chr(34))
    lig = 1
    For i = 1 To UBound(coupe)
        compte = compte + 1
        donnée = Split(coupe(i), Chr(34))(0)
       Cells(lig, compte) = IIf(compte < 2, donnée, Format(CDate((donnée / 86400) + CDbl(CDate("1/1/1970")) + (1 / 24)), "dd/mm/yyyy hh:nn:ss"))
        If compte = 2 Then lig = lig + 1: compte = 0
 
    Next
End Sub

bon..en meme temps les secondes a mons que se soit pour la nasa hein!!!!

**dodinouche** · 30/07/2015, 13h17

MERCI BEAUCOUP !!!!

Vous m'avez sauvez la vie tous les deux. It's just amazing !

Si je voudrais juste rajouter pour la colone "value_Mesure" un "%" derrière chaque nombre ?

Merci encore

**patricktoulon** · 30/07/2015, 13h21

dans la formule de PMO

Code :

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

1
2
3
For i& = LBound(var) To UBound(var)
  S.Range("a" & i& + 1 & "") = "%" & var(i&)
Next i&

**PMO2017** · 30/07/2015, 13h25

Salut patricktoulon,

J'étais parti sur IE et y suis donc resté.

en l'adaptant a mon principe je n'arrive pas a avoir les secondes c'est assez etonnant

Voir ton code modifié ('///)

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
Sub test2()
    Dim ReQ, URL, coupe, compte, lig
    URL = "http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "POST", URL, False:    ReQ.send
    coupe = Split(ReQ.responsetext, "Mesure"":" & Chr(34))
    lig = 1
    For i = 1 To UBound(coupe)
        compte = compte + 1
        donnée = Split(coupe(i), Chr(34))(0)
       Cells(lig, compte) = IIf(compte < 2, donnée, Format(CDate((donnée / 86400) + CDbl(CDate("1/1/1970")) + (1 / 24)), "dd/mm/yyyy hh:mm:ss"))
 
'///ajout (spécifie le format de la cellule ET NON PAS celui de son contenu)
Cells(lig, compte).NumberFormat = "dd/mm/yyyy hh:mm:ss"
'///
        If compte = 2 Then lig = lig + 1: compte = 0
 
    Next
End Sub

**patricktoulon** · 30/07/2015, 13h32

RE
ET OUI MAIS NON

EN AJOUTANT TA LIGNE TU CONVERTI LES DEUX COLONNE AU FORMAT

Code :

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

1
2
3
'///ajout (spécifie le format de la cellule ET NON PAS celui de son contenu)
Cells(lig, 2).NumberFormat = "dd/mm/yyyy hh:mm:ss"
'///

MAIS J'AI QUAND MEME UN SOUCIS

mon exemple ne donne pas les meme dates que toi pourtant j'ai ta formule

essaie le tiens sur un sheets et le mien sur un autre sheets tu verra

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
Sub test4() Dim ReQ, URL, coupe, compte, lig URL = "http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31" Set ReQ = CreateObject("microsoft.xmlhttp") ReQ.Open "POST", URL, False: ReQ.send coupe = Split(ReQ.responsetext, "Mesure"":" & Chr(34)) lig = 1 For i = 1 To UBound(coupe) compte = compte + 1 donnée = Split(coupe(i), Chr(34))(0) Cells(lig, compte) = IIf(compte < 2, donnée, Format(CDate((donnée / 86400) + CDbl(CDate("1/1/1970")) + (1 / 24)), "dd/mm/yyyy hh:mm:ss")) '///ajout (spécifie le format de la cellule ET NON PAS celui de son contenu) Cells(lig, 2).NumberFormat = "dd/mm/yyyy hh:mm:ss" '/// If compte = 2 Then lig = lig + 1: compte = 0 Next End Sub

**dodinouche** · 30/07/2015, 13h42

Patricktoulon,

Et dans ton code à toi pour le pourcentage il faut le situer où ?

Merci

**patricktoulon** · 30/07/2015, 13h44

re
ici

Code :

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

Cells(lig, compte) = IIf(compte < 2, "%" & donnée, Format(CDate((donnée / 86400) + CDbl(CDate("1/1/1970")) + (1 / 24)), "dd/mm/yyyy hh:mm:ss"))

mais attention!!! les dates ne sont pas les meme que PMO!!!!

**dodinouche** · 30/07/2015, 13h46

C'est bizarre car sur le fichier Excel, une fois la macro lancé, il semblerait que ce soit les mêmes dates !

Clément.

**patricktoulon** · 30/07/2015, 13h49

non ce ne sont pas les meme
regarde bien

par contre j'ai plus de mois que PMO
RESTE A SAVOIR CE QUE TU ATTENDS car pour le moment j'essai de comprendre pourquoi PMO et moi n'avons pas le meme résultat avec la meme formule

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
Sub test4()
    Dim ReQ, URL, coupe, compte, lig
    URL = "http://aguila-bidart.fr/demo/ISSY/webservice.php?ndDay=31"
    Set ReQ = CreateObject("microsoft.xmlhttp")
    ReQ.Open "POST", URL, False:    ReQ.send
    coupe = Split(ReQ.responsetext, "Mesure"":" & Chr(34))
    lig = 1
    For i = 1 To UBound(coupe)
        compte = compte + 1
        donnée = Split(coupe(i), Chr(34))(0)
       Cells(lig, compte) = IIf(compte < 2, "%" & donnée, Format(CDate((donnée / 86400) + CDbl(CDate("1/1/1970")) + (1 / 24)), "dd/mm/yyyy hh:mm:ss"))
 
'///ajout (spécifie le format de la cellule ET NON PAS celui de son contenu)
Cells(lig, 2).NumberFormat = "dd/mm/yyyy hh:mm:ss"
'///
        If compte = 2 Then lig = lig + 1: compte = 0
 
    Next
End Sub