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

VBA Access Discussion :

A-00] Connexion à un site Web avec récupération partielle du code source d’une page H


Sujet :

VBA Access

  1. #1
    Membre à l'essai
    Profil pro
    Inscrit en
    décembre 2008
    Messages
    31
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : décembre 2008
    Messages : 31
    Points : 17
    Points
    17
    Par défaut A-00] Connexion à un site Web avec récupération partielle du code source d’une page H
    Bonjour à toutes et tous,

    Je souhaite récupérer dans une variable une partie du code source d’une page HTML.
    En compilant plusieurs codes trouvés sur le forum, la connexion à la page souhaitée et son affichage se réalisent sans problème.

    Deux questions :

    1) Je souhaite ajouter un message qui avertit l’utilisateur si la page ne s’affiche pas ou la connexion à internet n’est pas active par exemple.
    L’écriture suivante ne fonctionne pas :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Set IE = CreateObject("InternetExplorer.Application")
    If IE.Busy = True Or IE.ReadyState <> READYSTATE_COMPLETE Then
    MsgBox "L'accès à la page internet demandée n'a pu être réalisé." & Chr(10) & "Veuillez vérifier l'état de la connexion à internet et recommencer l'opération.", vbOKOnly + vbExclamation, "ECHEC DE CONNEXION A INTERNET"
    Exit Sub
    End If
    2) J’ai des difficultés à récupérer la partie de caractères qui m’intéresse qui est le contenu de l’attribut « href », lui-même nœud associé de l’élément « a ». J’utilise l’objet HTML DOM. Je ne parviens pas à intégrer en VBA le code suivant (fonctionnel en Javascript) : var=document.getElementsByTagName(« a »)[0].href.
    Code actuel qui présente des erreurs de type ‘Objet’ et déclaration de variable. J’ai activé les références Microsoft HTML Objects Library et Microsoft Internet Controls
    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
    '---------------------------------------------------------------------------------------
    ' Procedure : Extraction Coordonnées Lambert
    ' DateTime  : 12/12/2008 23:09
    ' Author    : Basé sur le code de Philben - www.developpez.com
    ' Purpose   : Extraction des coordonnées Lambert du PRAS suivant l'adresse
    '---------------------------------------------------------------------------------------
     
    Dim IE As InternetExplorer
    Dim CodeSource As HTMLDocument
    Dim data As IHTMLElementCollection
    Dim sCoord As String
    Dim dX, dY As Double
    Dim repere As Integer
    Dim dRUE As String
    Dim IPOS As Byte
     
    IPOS = InStr(Me.Rue, "/")
    dRUE = Left(Me.Rue, IPOS - 1)
     
    'DoCmd.Hourglass True
     
    'Création de l'URL d'appel, renvoi d'un HTML contenant les informations
     
    Set IE = CreateObject("InternetExplorer.Application")
     
    If IE.Busy = True Or IE.ReadyState <> READYSTATE_COMPLETE Then
    MsgBox "L'accès à la page internet demandée n'a pu être réalisé." & Chr(10) & "Veuillez vérifier l'état de la connexion à internet et recommencer l'opération.", vbOKOnly + vbExclamation, "ECHEC DE CONNEXION A INTERNET"
    Exit Sub
    End If
     
    IE.Visible = True
     
       IE.navigate "http://geowebas1.ci.irisnet.be/PRASAFFECTATIONFR/adrResForm.jsp?" & _
        "pst=" & Me.CP.Value & _
        "&mun=0" & _
        "&str=" & dRUE & _
        "&nbr=" & Me.N°.Value & _
        "&lng=fr"
    Do Until IE.ReadyState = READYSTATE_COMPLETE
    DoEvents
    Loop
      'Créér l'objet html
       Set CodeSource = IE.Document
     
       'Recherche des coordonnées
     
            'Set data = CodeSource.getElementsByTagName("a")[0].href
     
        sCoord = data
     
        repere = InStr(sCoord, "zoomTo")
     
                'Isoler les coordonnées X et Y
                If repere Then
                   dX = Val(Mid$(sCoord, repere + 7, 10))
                   dY = Val(Mid$(sCoord, repere + 19, 10))
                End If
     
    'DoCmd.Hourglass False
     
    Me.Coord_X = dX
    Me.Coord_Y = dY
     
    fin:
    Set CodeSource = Nothing
     
    Me.Type_bien_maison.SetFocus
    Je joins également une partie du code de la page HTML avec les données que je souhaite récupérer dans une variable.

    Code HTML : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    <body leftmargin="2" topmargin="2" bgcolor="#2780C5" text="white" onload="zoomTo(147924.889, 167490.169, -1, -1, 'Rue Cervantès, 65')">
     
    <div <table width="321" border="0" align="left" cellpadding="5" cellspacing="2">
    <tr><td width="40"  align="left" valign="middle"><img  onClick="adrForm()" src="images/jumelle.gif" width="47" height="27"></td>
        <td width="281" align="left" valign="middle">R&eacute;sultat de la recherche</td></tr>
    </table><table border="1" align="left" cellpadding="3" cellspacing="3" bordercolor="#15466A" bgcolor="#2780C5" nowrap>
    <tr><td>Rec</td><td>Adresse</td></tr>
    <tr><td><a href="JavaScript:zoomTo(147924.889, 167490.169, -1, -1, 'Rue Cervantès, 65')">1</a></td><td>Rue Cervantès 65, 1190 Forest (Cervantesstraat)</td></tr>
    </table>
     
    </body>

    Merci d’avance pour votre aide.

  2. #2
    Expert éminent
    Avatar de LedZeppII
    Homme Profil pro
    Maintenance données produits
    Inscrit en
    décembre 2005
    Messages
    4 485
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Maintenance données produits
    Secteur : Distribution

    Informations forums :
    Inscription : décembre 2005
    Messages : 4 485
    Points : 7 643
    Points
    7 643
    Par défaut
    Bonjour,

    Pour la question 2) , un exemple :
    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
    Dim IE As SHDocVw.InternetExplorer
    Dim CodeSource As HTMLDocument
    Dim colHtmlElts As MSHTML.IHTMLElementCollection
    Dim alink As MSHTML.HTMLAnchorElement, i As Long
     
    'Crée un objet internet Explorer
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
     
    'Ouvre la page
    IE.navigate "http://www.developpez.com/"
     
    'attend que la page soit chargée
    Do While IE.readyState <> READYSTATE_COMPLETE Or IE.Busy = True
       DoEvents
    Loop
     
    Set CodeSource = IE.Document
    Set colHtmlElts = CodeSource.getElementsByTagName("a")
    For i = 0 To colHtmlElts.length - 1
        Set alink = colHtmlElts(i)
        If alink.href Like "*Office*" Then Debug.Print alink.innerText & " : " & alink.href
    Next
    A+

  3. #3
    Membre à l'essai
    Profil pro
    Inscrit en
    décembre 2008
    Messages
    31
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : décembre 2008
    Messages : 31
    Points : 17
    Points
    17
    Par défaut
    Merci pour la réponse. Je l'ai légèrement adaptée (voir code ci-dessous). Ca fonctionne parfaitement sur mon pc au bureau . Par contre, sur mon pc personnel, le code coince à la ligne
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set CodeSource = IE.Document
    Avec message d'erreur :
    "Erreur de compilation
    Mécanisme de bibliothèque d'objets non géré"

    J'ai cependant bien activé les références Microsoft HTML Object Library et Microsoft Internet Controls

    D'où proviendrait cette erreur ?

    Merci d'avance !

    Voici le code complet :
    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
    '---------------------------------------------------------------------------------------
    ' Procedure : Extraction Coordonnées Lambert
    ' DateTime  : 12/12/2008 23:09
    ' Author    : Basé sur le code de Philben - www.developpez.com
    ' Purpose   : Extraction des coordonnées Lambert du PRAS suivant l'adresse
    '---------------------------------------------------------------------------------------
     
    Dim IE As SHDocVw.InternetExplorer
    Dim CodeSource As HTMLDocument
    Dim colHtmlElts As Object
    Dim dX, dY As Double
    Dim repere, repere1, repere2, repere3, longX, longY As Integer
    Dim dRUE As String
    Dim IPOS As Byte
    Dim i As Object
     
    If IsNull(Me.CP) Then
        MsgBox "Veuillez introduire le code postal", vbOKOnly + vbInformation, "ATTENTION"
        Me.CP.SetFocus
        Exit Sub
    End If
     
    If IsNull(Me.Rue) Then
        MsgBox "Veuillez introduire le nom de la rue", vbOKOnly + vbInformation, "ATTENTION"
        Me.Rue.SetFocus
        Exit Sub
    End If
     
    If IsNull(Me.N°) Then
        MsgBox "Veuillez introduire le numéro de police", vbOKOnly + vbInformation, "ATTENTION"
        Me.N°.SetFocus
        Exit Sub
    End If
     
    DoCmd.Hourglass True
     
    IPOS = InStr(Me.Rue, "/")
    dRUE = Left(Me.Rue, IPOS - 1)
     
    'Création de l'URL d'appel, renvoi d'un HTML contenant les informations
     
    Set IE = CreateObject("InternetExplorer.Application")
     
    'If IE.Busy = True Or IE.ReadyState <> READYSTATE_COMPLETE Then
    'MsgBox "L'accès à la page internet demandée n'a pu être réalisé." & Chr(10) & "Veuillez vérifier l'état de la connexion à internet et recommencer l'opération.", vbOKOnly + vbExclamation, "ECHEC DE CONNEXION A INTERNET"
    'Exit Sub
    'End If
     
    IE.Visible = False
     
    'Ouvre la page du PRAS
       IE.navigate "http://geowebas1.ci.irisnet.be/PRASAFFECTATIONFR/adrResForm.jsp?" & _
        "pst=" & Me.CP.Value & _
        "&mun=0" & _
        "&str=" & dRUE & _
        "&nbr=" & Me.N°.Value & _
        "&lng=fr"
     
    'attente fin de chargement
    Do Until IE.readyState = 4
       DoEvents
    Loop
     
    'Récupération du code source
    Set CodeSource = IE.Document
     
    Set i = CodeSource.getElementsByTagName("a")
    If i.Length = 0 Then
    MsgBox "L'adresse renseignée est incomplète ou inexistante sur le site du PRAS.", vbOKOnly + vbExclamation, "PAS DE RESULTAT TROUVE SUR LE SITE DU PRAS"
    DoCmd.Hourglass False
    Exit Sub
    ElseIf i.Length > 1 Then
    MsgBox "L'adresse renseignée correspond à plusieurs résultats sur le site du PRAS." & Chr(10) & "Veuillez vous connecter manuellement sur le site du PRAS, encoder l'adresse et sélectionner un des résultats proposés.", vbOKOnly + vbExclamation, "L'ADRESSE CORRESPOND A PLUSIEURS RESULTATS DE RECHERCHE"
    DoCmd.Hourglass False
    Exit Sub
    Else
    Set colHtmlElts = CodeSource.getElementsByTagName("a").Item
     
    'Recherche des coordonnées
    repere = InStr(colHtmlElts, "zoomTo")
    repere1 = InStr(colHtmlElts, "%20")
    repere2 = InStr(colHtmlElts, "%20-1")
    longX = repere1 - repere - 7
    longY = repere2 - repere1 - 3
     
    'Isoler les coordonnées X et Y
    If repere Then
    dX = Val(Mid$(colHtmlElts, repere + 7, longX))
    dY = Val(Mid$(colHtmlElts, repere1 + 3, longY))
    End If
     
    Me.Coord_X = dX
    Me.Coord_Y = dY
     
    DoCmd.Hourglass False
     
    'fin:
    Set CodeSource = Nothing
     
    Me.Type_bien_maison.SetFocus
     
    End If

  4. #4
    Membre à l'essai
    Profil pro
    Inscrit en
    décembre 2008
    Messages
    31
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : décembre 2008
    Messages : 31
    Points : 17
    Points
    17
    Par défaut
    Bonsoir,

    Pour ma question 1) j'ai pensé au code suivant, que je ne peux malheureusement pas tester. L'objectif est d'abandonner la tentative de connexion et d'afficher un message après 10 secondes si la connexion à internet ne se réalise pas ou si la page ne peut s'afficher. Ce code tient-il la route ?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Dim Start, Delai
    Start = Timer
    Delai = Start + 10
     
    Do Until IE.readyState = 4 Or Delai = True
       DoEvents
    Loop
     
    'Message si pas de connexion
    If IE.Busy = True Or IE.readyState <> READYSTATE_COMPLETE Then
    MsgBox "L'accès à la page internet demandée n'a pu être réalisé." & Chr(10) & "Veuillez vérifier l'état de la connexion à internet et recommencer l'opération.", vbOKOnly + vbExclamation, "ECHEC DE CONNEXION A INTERNET"
    Exit Sub
    End If
    Pour ma question 2) le fait que j'ai installé Firefox et que ce soit mon navigateur par défaut peut-il être la cause du dysfonctionnement ? Si cette question n'a pas lieu d'être dans cette discussion, un modérateur pourrait-il la rediriger vers le forum adéquat ?

    Merci d'avance de votre coup de main

  5. #5
    Expert éminent
    Avatar de LedZeppII
    Homme Profil pro
    Maintenance données produits
    Inscrit en
    décembre 2005
    Messages
    4 485
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Maintenance données produits
    Secteur : Distribution

    Informations forums :
    Inscription : décembre 2005
    Messages : 4 485
    Points : 7 643
    Points
    7 643
    Par défaut
    Bonjour,

    Voila comment je ferai pour l'expiration du délai d'attente.
    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
    ' Référence VB utilisées
    ' Microsoft Internet Controls   : Library SHDocVw (\WINDOWS\system32\shdocvw.dll)
    ' Microsoft HTML Object Library : Library MSHTML (\WINDOWS\system32\MSHTML.TLB)
    Dim IE As SHDocVw.InternetExplorer
    Dim htDoc As MSHTML.HTMLDocument
    Dim tmr As Single, tmOutValue As Single, bTimeout As Boolean
     
    Set IE = New SHDocVw.InternetExplorer
    IE.Visible = True
    IE.navigate "http://192.0.0.99"
    'IE.navigate "http://login.aliceadsl.fr/default.php"
     
    ' Timeout 10Sec
    tmOutValue = 10: tmr = Timer
    Do
      DoEvents
      bTimeout = ((Timer - tmr) > tmOutValue)
    Loop Until (IE.Busy = False And IE.ReadyState = READYSTATE_COMPLETE) _
                Or bTimeout
     
    If bTimeout Then
       IE.Stop
       IE.Quit
       MsgBox "Délai d'attente (" & CStr(tmOutValue) & " sec) expiré"
       Exit Sub
    End If
    Mais il y a d'autres types d'erreurs possibles.

    A vérifier, mais voila ce que j'ai constaté avec l'objet InternetExplorer.
    S'il y a une erreur dans l'URL, l'objet InternetExplorer crée et affiche une page d'erreur.
    Ceci, dans un délai qui peut-être inférieur à celui du délai d'attente maximum défini.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    ' Récupérer l'objet Document de la page
    Set htDoc = IE.Document
    La propriété Url de l'objet htDoc contient quelque chose du style :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    res://C:\WINDOWS\system32\shdoclc.dll........
    Ça peut être un moyen de détecter les autres types d'erreur.


    Pour ce qui est de l'erreur "Erreur de compilation : Mécanisme de bibliothèque d'objets non géré",
    je ne l'ai jamais vue.
    A tout hasard, remplace
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Dim CodeSource As HTMLDocument
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Dim CodeSource As MSHTML.HTMLDocument
    au cas où tu aurai plus d'une bibliothèque ayant la classe HTMLDocument.
    ou même carrement
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Dim CodeSource As Object
    A+

  6. #6
    Membre à l'essai
    Profil pro
    Inscrit en
    décembre 2008
    Messages
    31
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : décembre 2008
    Messages : 31
    Points : 17
    Points
    17
    Par défaut
    Un tout grand merci pour tes lumières, LedZeppII

    Pour la question 2, j'ai résolu le problème en réinstallant Internet Explorer (j'en ai profité pour installer la version 8) et en définissant Internet Explorer comme navigateur par défaut (sinon la ligne de code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    IE.Visible = True/False
    n'a pas d'effet !

    Encore merci !

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

Discussions similaires

  1. [XL-2010] Récupération de données sur site web avec mot de passe
    Par SkyCorp dans le forum Macros et VBA Excel
    Réponses: 41
    Dernier message: 15/07/2014, 15h10
  2. Import Page WEB en VBA : Récupération partielle du code source
    Par Aurélien VH. dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 18/02/2013, 20h19
  3. Réponses: 4
    Dernier message: 24/02/2006, 08h16
  4. Site web avec contenu payant
    Par Giill dans le forum E-Commerce
    Réponses: 6
    Dernier message: 17/08/2005, 21h23
  5. Problème Site Web avec Firefox
    Par bodybug dans le forum Balisage (X)HTML et validation W3C
    Réponses: 5
    Dernier message: 23/01/2005, 23h48

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