Se contecter a Intranet via Excel
Je voulais utiliser le super tuto de QUAZERTY, mais ie.navigate affichait la page et perdait la connection.
Apres de longue recherche sur Internet :
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
103
104
105
106
107
108
109
110
111
| 'Activer les références
' - Microsoft HTML Objects Library
' - Microsoft Internet Controls
' - Microsoft shell control et automation
'Dans un module
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'---
Const StUrl = "C:/Users/Saugedic/Documents/MonSite/CreationPage.html"
'---
'*********************************************
' Se Connecter à une page Html local
'*********************************************
Sub connexion()
On Error GoTo ERR_Sub
'Afficher la page html
'---------------------
Dim ie As InternetExplorer
Set ie = New InternetExplorer
With ie
.Visible = True
.navigate StUrl
'affiche la page et .. perd la connection - ie.readystate vide -> err
' Do Until .readyState = 4
' DoEvents
' Loop
End With
' Attendre la fin du chargement
Sleep (300)
'Se (re)connecter
Dim objShell As Object, obj As Object
Set objShell = New Shell
For Each obj In objShell.Windows
If TypeName(obj.document) = "HTMLDocument" Then
If obj.LocationName Like "*CreationPage*" Then
'Des que l'on trouve l'instance chargée - Reconnecter la page
Set ie = obj
Exit For
End If
End If
Next
'Ecrire dans la page
'---------------------
' Dim IEdoc As Object - Set IEdoc = ie.document
' Formulaire de connexion ...
ie.document.all("autre").Value = "login"
ie.document.all("Bouton1").Click
'F12 sur Google pour connaitre les noms des champs
GoTo FIN_Sub
'--------------------
ERR_Sub:
MsgBox "Erreur : " & Err.Number & " (" & Hex(Err.Number) & ")" & vbCrLf & Err.Description
On Error GoTo 0
FIN_Sub:
'--------------------
ie.Quit
Set ie = Nothing
'Set IEdoc = Nothing
'---
End Sub
'Pour tester
'*********************************************
' Créer une page html
'*********************************************
Sub test()
On Error GoTo ERR_Sub
'Creer la page html
'--------------------
Dim xFile As Integer
xFile = FreeFile
Open "C:\Users\Saugedic\Documents\MonSite\CreationPage.html" For Output As xFile
Print #xFile, "<HTML>"
Print #xFile, "<HEAD>"
Print #xFile, "<TITLE>Ma page de saisie</TITLE>"
Print #xFile, "</HEAD>"
Print #xFile, "<BODY>"
Print #xFile, "<FORM>" & _
"<input type='text' size='10' name='autre'><br>" & _
"<Input type=button name='Bouton1' value='Validez'>" & _
"</FORM>"
Print #xFile, "</BODY>"
Print #xFile, "</HTML>"
Close xFile
Exit Sub
'---
ERR_Sub:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Error 0
'---
End Sub |
** J etrouve toujours tout sur ce site, alors pour une fois :oops: **
