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