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

Version imprimable

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:

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:

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:

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.

Bonjour,

Pour la question 2) , un exemple :

Code:

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+

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 :P. Par contre, sur mon pc personnel, le code coince à la ligne

Code:

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:

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

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:

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 ;)

Bonjour,

Voila comment je ferai pour l'expiration du délai d'attente.
Code:

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:

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:

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:

Dim CodeSource As HTMLDocument

par

Code:

Dim CodeSource As MSHTML.HTMLDocument

au cas où tu aurai plus d'une bibliothèque ayant la classe HTMLDocument.
ou même carrement

Code:

Dim CodeSource As Object

A+

21/03/2009, 17h33
Domdrum

Un tout grand merci pour tes lumières, LedZeppII :king:

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:

IE.Visible = True/False

n'a pas d'effet !

Encore merci !