Discussion :

[BENNASR]

Bonsoir à tous , et bonne weekend d'avance
de patrick touloun j'ai eu un super code qui me permet de télécharger des info d'un site internet
j'ai fait des recherches sur le net et j'ai trouver un bout de code qui vérifié si il y a connexion internet il exécute le code si non un message me dire pas de connexion internet
jusque la tous et parfait mais j'ai constaté que parfois il y a internet mais le site est inaccessible pour entretien mise à jour ou autre
comment faire pour tester avant de démarrer le code si le site est accessible ou non
Merci à tous

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
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Public Function ConnectéInternet() As Boolean
ConnectéInternet = IIf(InternetGetConnectedState(0&, 0&) = 1, True, False)
End Function
Sub IMPORTATIONCOURSBCT()
Application.ScreenUpdating = False
Sheets("COURS").Cells.Clear
If ConnectéInternet = Faux Then
MsgBox "Echec de Connexion à Inetrnet : cours de devise ne sont pas à jour"
Exit Sub
Else
' requte 1 : cours de devise
    Dim ReQ, shap, mémorisation, CodeHtMl
    Set ReQ = CreateObject("microsoft.xmlhttp")
    With ReQ
        .Open "post", "https://www.bct.gov.tn/bct/siteprod/cours.jsp", False: .send
        CodeHtMl = ReQ.responsetext
        With CreateObject("htmlfile")
            .body.innerhtml = CodeHtMl
            mémorisation = .parentwindow.clipboardData.SetData("Text", .getelementsbytagname("TABLE")(0).outerhtml)
            With Sheets("COURS")
                 .Activate
                 .Cells(1, 1).Select
                 .Paste
                ' netoyage des shapes vides qui seront de toute facon vide daans le sheets
                For Each shap In .Shapes
                    If shap.Name Like "*Auto*" Then shap.Delete
                Next
            End With
        End With
    End With
   Application.ScreenUpdating = True
End Sub

[BENNASR]

bonsoir
est ce que si j’insère On Error Resume Next après la 11ème ligne résolu l'affaire ??
Bonne soirée

[patricktoulon]

salut bennars

si tu change l'object pour son ancêtre tu aura la proriété settimeout pour accorder le delai que tu veux

les delays sont en milliseconde 1000 = 1 seconde

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
Set ReQ = CreateObject("WinHttp.WinHttpRequest.5.1") 'setTimeOuts
    With ReQ
            lResolve = 5000 'delay pour la resolution des erreurs eventuelles
            lConnect = 5000 'delay pour la connection
            lSend = 5000 'delay pour vba pour envoyer
            lReceive = 150000    'delay pour attendre les données
            ReQ.setTimeOuts lResolve, lConnect, lSend, lReceive
            .Open "post", "https://www.bct.gov.tn/bct/siteprod/cours.jsp", False: .send
 
               If .Status = 200 Then
               'si c'est bon
               'le reste du code ici  
 
 
               else
              'si c'est pas bon
 
                msgbox " delay depassé"end if 
end with

[BENNASR]

Bonjour patrick, la forum

Merci pour la réponse, ça fonctionne
bonne journée

[BENNASR]

Bonsoir patrick la forum
Désolé de ré ouvrir cette discussion , j'ai essayer d'adapter depuis le matin la solution Patrick mais vu mon niveau je sèche
j'ai parcourais les sites web et j'ai arrivé à comprendre un peu les statuts HTML depuis ce lien :

https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

mon problème :
je récupère 3 tables : 01 table du www.fxstreet.fr et c'est la première partie du code qui fonctionne à merveille
les 02 autres tables issue du site www.bct.gov.tn et ici c'est le problème vu qu'il s'agit d'un site un peu lent (et voir même trop lent) pour cela et sur les directive de Patrick j'ai prolongé les délai d'attente de connexion (j'ai ajouter bq de 0 ) mais je crois qu'il n'est pas entrain de prendre en compte les nouveaux délais
voila mon 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
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Public Function ConnectéInternet() As Boolean
ConnectéInternet = IIf(InternetGetConnectedState(0&, 0&) = 1, True, False)
End Function
Sub IMPORTATIONCOURSBCT()
Application.ScreenUpdating = False
Sheets("COURS").Cells.Clear
If ConnectéInternet = Faux Then
MsgBox "Echec de Connexion à Inetrnet : cours de devise ne sont pas à jour"
Exit Sub
Else
Dim ReQ, shap, mémorisation, CodeHtMl
'requette EUR/DOLLAR
 
     Set ReQ = CreateObject("WinHttp.WinHttpRequest.5.1")
    With ReQ
            lResolve = 5000 'delay pour la resolution des erreurs eventuelles
            lConnect = 5000 'delay pour la connection
            lSend = 5000 'delay pour vba pour envoyer
            lReceive = 150000    'delay pour attendre les données
            ReQ.setTimeOuts lResolve, lConnect, lSend, lReceive
        .Open "post", "http://www.fxstreet.fr/rates/forex-rates", False: .send
        If .Status = 200 Then
        CodeHtMl = ReQ.responsetext
        With CreateObject("htmlfile")
            .body.innerhtml = CodeHtMl
            mémorisation = .parentwindow.clipboardData.SetData("Text", .getelementsbytagname("TABLE")(0).outerhtml)
            With Sheets("COURS")
                 .Activate
                 .Cells(1, 12).Select
                 .Paste
                ' netoyage des shapes vides qui seront de toute facon vide daans le sheets
                For Each shap In .Shapes
                    If shap.Name Like "*Auto*" Then shap.Delete
                Next
            End With
        End With
        Else
                MsgBox "Problème de Connexion au site www.fxstreet.fr"
            End If
    End With
 
 
' requte 1 : cours de devise
Dim ReQ1, shap1, mémorisation1, CodeHtMl1
Set ReQ1 = CreateObject("WinHttp.WinHttpRequest.5.1") 'setTimeOuts
    With ReQ1
            lResolve = 12000000 'delay pour la resolution des erreurs eventuelles
            lConnect = 120000000 'delay pour la connection
            lSend = 5000000 'delay pour vba pour envoyer
            lReceive = 150000000    'delay pour attendre les données
            ReQ1.setTimeOuts lResolve, lConnect, lSend, lReceive
            .Open "post", "https://www.bct.gov.tn/bct/siteprod/cours.jsp", False: .send
 
               If .Status = 200 Then
 
                    CodeHtMl1 = ReQ1.responsetext
                    With CreateObject("htmlfile")
                        .body.innerhtml = CodeHtMl
                         mémorisation1 = .parentwindow.clipboardData.SetData("Text", .getelementsbytagname("TABLE")(0).outerhtml)
                          With Sheets("COURS")
                              .Activate
                              .Cells(1, 1).Select
                              .Paste
                ' netoyage des shapes vides qui seront de toute facon vide daans le sheets
                             For Each shap1 In .Shapes
                                 If shap1.Name Like "*Auto*" Then shap1.Delete
                             Next
                             End With
                          End With
                 Else
                MsgBox "Problème de Connexion au site www.bct.gov.tn"
                End If
     End With
 
 
 
 'requete 2 : cours à terme
 
    Dim ReQ2, shap2, mémorisation2, CodeHtMl2
   Set ReQ2 = CreateObject("WinHttp.WinHttpRequest.5.1") 'setTimeOuts
    With ReQ2
           lResolve = 1200000 'delay pour la resolution des erreurs eventuelles
           lConnect = 1200000 'delay pour la connection
           lSend = 5000000 'delay pour vba pour envoyer
            lReceive = 150000000    'delay pour attendre les données
            ReQ.setTimeOuts lResolve, lConnect, lSend, lReceive
           .Open "post", "https://www.bct.gov.tn/bct/siteprod/cours.jsp", False: .send
         If .Status = 200 Then
              CodeHtMl2 = ReQ2.responsetext
              With CreateObject("htmlfile")
                  .body.innerhtml = CodeHtMl2
                   mémorisation2 = .parentwindow.clipboardData.SetData("Text", .getelementsbytagname("TABLE")(2).outerhtml)
                        With Sheets("COURS")
                           .Activate
                           .Cells(1, 7).Select
                           .Paste
                ' netoyage des shapes vides qui seront de toute facon vide daans le sheets
                           For Each shap2 In .Shapes
                           If shap2.Name Like "*Auto*" Then shap2.Delete
                           Next
                        End With
               End With
             Else
                MsgBox "Problème de Connexion au site www.bct.gov.tn"
            End If
    End With
 End If
 Application.ScreenUpdating = True
End Sub

BONNE SOIRÉE A VOUS TOUS

[patricktoulon]

Bonjour
déjà pour https://www.bct.gov.tn/bct/siteprod/cours.jsp, tu n'a pas besoins de faire deux fois la requête
tu le recupere comme suit pour la 1 et 2
texte=.getelementsbytagname("TABLE")(0) & "<br>" &.getelementsbytagname("TABLE")(1)
et tu met texte dans le clipboard

après pour être honnête ayant testé je trouve ce site particulièrement lent et perso c'est rédhibitoire pour moi je vais voir si l'herbe elle plus verte ailleurs