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
112
113
114
115
116
117
118
| Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
' Activate an application window.
Private Declare Function SetForegroundWindow Lib "user32.dll" _
(ByVal hwnd As Long) As Boolean
Function Parse(str As String) As String
Dim s As String, r As String
Dim Rank As String, hRef As String, Name As String, Points As String
s = str
Do While InStr(s, "<SPAN class=rate>")
Rank = Split(Split(s, "<SPAN class=rate>")(1), "</SPAN>")(0)
hRef = Split(Split(s, "href=""")(1), """>")(0)
s = Mid(s, InStr(s, "href=""" & hRef & """>") + Len("href=""" & hRef & """>"))
Name = Split(s, "</A>")(0)
Points = Split(Split(s, "<DIV class=chrono>")(1), "</DIV>")(0)
r = r & vbCrLf & Rank & ";" & hRef & ";" & Name & ";" & Points
Loop
Parse = r
End Function
Function GetIE(ByVal titre As String, ByVal action As String, _
Optional ByVal BoucleMax As Long = 20) As String
' getie "Sélect", "WRI=SAPBWHIGH_1=12"
' getie "Sélect. val. filtre", "LNK=javascript:execute_export();"
Dim WinShell As New ShellWindows
Dim IEapp As New InternetExplorer
Dim doc As HTMLDocument
Dim ctl As Object
Dim i As Integer
'On Error Resume Next
For Each IEapp In WinShell
If IEapp.LocationName Like "*" & titre & "*" Then
Select Case Left(action, 3)
Case "WRI" ' remplir un formulaire
Do While IEapp.Busy Or IEapp.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop 'attend la fin du chargement pour continuer la procedure
Set doc = IEapp.Document
Set ctl = doc.getElementsByName(Split(action, "=")(1))
ctl(0).Value = Split(action, "=")(2)
Case "LNK" ' cas d'un lien
Do While IEapp.Busy Or IEapp.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop 'attend la fin du chargement pour continuer la procedure
Set doc = IEapp.Document
For i = 0 To BoucleMax
Debug.Print doc.Links(i).hRef
If doc.Links(i).hRef = Split(action, "=")(1) Then
doc.Links(i).Click
Exit For
End If
Next i
Do While IEapp.Busy Or IEapp.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop 'attend la fin du chargement pour continuer la procedure
Case "CLI" ' cas d'un bouton
Do While IEapp.Busy Or IEapp.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop 'attend la fin du chargement pour continuer la procedure
Set doc = IEapp.Document
Set ctl = doc.getElementById(Split(action, "=")(1))
ctl.Click
Do While IEapp.Busy Or IEapp.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop 'attend la fin du chargement pour continuer la procedure
Case "GET" ' pour récupérer de l'information
Do While IEapp.Busy Or IEapp.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop 'attend la fin du chargement pour continuer la procedure
Set doc = IEapp.Document
Set ctl = doc.getElementById(Split(action, "=")(1))
GetIE = ctl.innerHTML
Case "KEY" ' cas d'une séquence de touches
SetForegroundWindow IEapp.hwnd
ShowWindow IEapp.hwnd, 9 'RESTORE
SendKeys Split(action, "=")(1)
Case "CHK" 'vérifier
GetIE = "Ok"
Case "SCR" 'execution de script
Set doc = IEapp.Document
doc.parentWindow.execScript Split(action, "=")(1), "Javascript"
Case "URL" 'retrieve URL
GetIE = IEapp.LocationURL
End Select
Exit Function
End If
Next IEapp
Set doc = Nothing
Set ctl = Nothing
Set IEapp = Nothing
Set WinShell = Nothing
End Function |
