Discussion :

[Macmachi]

J'ai supprimé tous les doublons, donc je repose ma question :


Je cherche à récupérer certaines données gouvernementales (Open Data) de ce fichier txt en ligne (mis à jour toutes les 10min) :
http://data.geo.admin.ch.s3.amazonaw...dex/VQHA69.txt

Pour ensuite les afficher dans Visual Basic de façon propre et actualisé toutes les 10 minutes.

Si quelqu'un peut m'aider ou me donner une piste car je ne sais pas par où commencer! Je vous en serais reconnaissant.

[petit rabot]

Une ébauche...
avec un WebBrowser, un listbox, un commandbutton

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
Dim fso As Object, WS As Object, f, ST$
Const ForReading = 1, ForWriting = 2
 
Private Sub Command1_Click()
 
    'affiche la page et enregistre le fichier
    WebBrowser1.Navigate "http://data.geo.admin.ch.s3.amazonaws.com/ch.meteoschweiz.swissmetnet-foehnindex/VQHA69.txt"
    WebBrowser1.Visible = True
    Do While WebBrowser1.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop 'Attend la fin du chargement
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set WS = CreateObject("WScript.Shell")
    Set f = fso.OpenTextFile("C:\Wb.txt", 2, True)
    If WebBrowser1.Busy = False Then
        ST = WebBrowser1.Document.documentElement.innerHTML
        f.Write FindAndWrite(ST)
        f.Close
    End If
 
    'insère les lignes dans la list
    Set f = fso.OpenTextFile("C:\Wb.txt", ForReading)
    While Not f.AtEndOfStream
        List1.AddItem (f.ReadLine)
    Wend
    f.Close
 
End Sub
 
Private Function FindAndWrite(sText) As String
 
  Dim Ret$, tb() As String, I%, Trouve As Boolean
  tb = Split(sText, vbNewLine, , vbTextCompare)
  Ret = ""
  Trouve = False
  For I = LBound(tb) To UBound(tb)
    If UCase$(Mid$(tb(I), 1, 5) = "<BODY") Then Trouve = True
     If Trouve Then Ret = Ret + tb(I) + vbNewLine
     If UCase$(Mid$(tb(I), 1, 7) = "</BODY>") Then Exit For
  Next I
  FindAndWrite = Ret
 
End Function

A toi de continuer avec ça, il y a surement mieux...

[ProgElecT]

Salut
Une autre approche, sur un Form, 2 CommandButton, 1 TextBox et 1 Timer.

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
Option Explicit
 
'nécessite d'activer la référence Microsoft Internet Controls
Dim IE As InternetExplorer
'nécessite d'activer la référence Microsoft HTML Objects Library
Dim Doc As HTMLDocument
Dim AdrssSite As String
 
Dim DizaineMinutes As Integer
Dim ExitProg As Boolean
 
Private Sub Form_Load()
Timer1.Enabled = False
Command1.Move 60, 120, 1875, 315
Command1.Caption = "Scan immédiat"
Command2.Move 2040, 120, 1875, 315
Command2.Caption = "Scanner"
'Text1.ScrollBars = 2 '<-------  A faire en design
Text1.Move 60, 540, 9015, 5775
Text1.Text = ""
Me.Height = 6960: Me.Width = 9405
 
 
ExitProg = False
AdrssSite = "http://data.geo.admin.ch.s3.amazonaws.com/ch.meteoschweiz.swissmetnet-foehnindex/VQHA69.txt"
'Timer1.Interval = 60000 '1 Mn
Timer1.Interval = 5000 '5 Sc <---- pour la démo ----
End Sub
Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
ExitProg = True
If TypeName(Doc) <> "Nothing" Then Doc.Close: Set Doc = Nothing
If TypeName(IE) <> "Nothing" Then Set IE = Nothing
End Sub
 
Private Sub Command2_Click()
If Timer1.Enabled = True Then
    Command2.Caption = "Scanner"
    Timer1.Enabled = False
    Else
    Command2.Caption = "Scan en cours"
    DizaineMinutes = 0
    RecupInfos
    Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
RecupInfos '<---- A supprimer pour ton cas
' 5 lignes à libérer pour ton cas
'DizaineMinutes = DizaineMinutes + 1
'If DizaineMinutes = 9 Then
'    DizaineMinutes = 0
'    RecupInfos
'End If
End Sub
Private Sub Command1_Click()
RecupInfos
End Sub
 
Private Sub RecupInfos()
On Error GoTo Gesterr
Text1.Text = "Connexion ...."
 
Set IE = New InternetExplorer
IE.navigate AdrssSite
Do While IE.readyState <> READYSTATE_COMPLETE
    DoEvents
    If ExitProg = True Then Exit Sub
Loop
 
Text1.Text = "Récuperaion du document...."
Do While IE.document.readyState <> "complete"
    DoEvents
    If ExitProg = True Then Exit Sub
Loop
 
Set Doc = IE.document
Text1.Text = Now & vbNewLine & vbNewLine & Doc.childNodes(1).innerText
 
Doc.Close: Set Doc = Nothing
Set IE = Nothing
Exit Sub
 
Gesterr:
If TypeName(Doc) <> "Nothing" Then Doc.Close: Set Doc = Nothing
If TypeName(IE) <> "Nothing" Then Set IE = Nothing
Text1.Text = "Probléme inattendu"
End Sub

ensuite les afficher dans Visual Basic de façon propre

Cela devra faire partie d'une autre discussion.

[petit rabot]

Salut
Une autre approche, sur un Form, 2 CommandButton, 1 TextBox et 1 Timer.

Après essais, la version de ProgElecT est vraiment beaucoup plus pro que la mienne

[Macmachi]

merci beaucoup.

Je vais regarder ça mais j'ai vais peut-être d'abord passer par une base de donnée. D'ailleurs je vais créer un sujet sur le forum approprié pour demander conseil.

Encore merci

[Macmachi]

Je n'arrive pas à faire fonctionner ton code j'ai pleins d'erreurs de compilation

Je ferais un screen des erreurs ce week-end, je suis un peu débordé là