IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Récupération donnée site web : Connexion internet OK mais site inaccessible


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Expert confirmé Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    Décembre 2013
    Messages
    2 974
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : Décembre 2013
    Messages : 2 974
    Par défaut Récupération donnée site web : Connexion internet OK mais site inaccessible
    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

  2. #2
    Expert confirmé Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    Décembre 2013
    Messages
    2 974
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : Décembre 2013
    Messages : 2 974
    Par défaut
    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

  3. #3
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  4. #4
    Expert confirmé Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    Décembre 2013
    Messages
    2 974
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : Décembre 2013
    Messages : 2 974
    Par défaut
    Bonjour patrick, la forum

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

  5. #5
    Expert confirmé Avatar de BENNASR
    Homme Profil pro
    Responsable comptable & financier
    Inscrit en
    Décembre 2013
    Messages
    2 974
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Responsable comptable & financier
    Secteur : Finance

    Informations forums :
    Inscription : Décembre 2013
    Messages : 2 974
    Par défaut
    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 :
    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

  6. #6
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Connexion internet OK mais seulement sur Google
    Par nicomani dans le forum Windows 7
    Réponses: 9
    Dernier message: 31/12/2013, 08h53
  2. Problème connexion internet sur certains sites
    Par pierre24 dans le forum Dépannage et Assistance
    Réponses: 23
    Dernier message: 15/03/2013, 09h49
  3. Réponses: 0
    Dernier message: 18/06/2009, 21h26
  4. Réseau opérationnel, mais connexion internet impossible
    Par michelrx dans le forum Windows XP
    Réponses: 1
    Dernier message: 25/05/2008, 09h55

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo