Navigation Internet privée

Version imprimable

Voir 40 message(s) de cette discussion en une page

05/01/2017, 17h31
yoyof

Citation:

J'ai édité le post #18 à ton attention …

Oui effectivement, j'ai vu. Merci.
05/01/2017, 18h08
patricktoulon

re

re
@Marc j'aime bien la derniere
mais le read de la clé est pour moi parfaitement inutile car la encore il donne le chemin 64 byte

et il faut pas oublier qu'avec un office 32 l'exploitation du document sera plus difficile due au fait que certaines fonctions comme par exemple getclassname ne fonctionneront pas

problème qui a été corrigé pour la librairie elle même de vba office y a moins d'un an

je sais pas si avec environ on aurait pas le chemin 32byte
A explorer

maintenant parier sur le .count des Windows dans un while pour déterminer la bonne fenêtre c'est astucieux mais est ce vraiment fiable je sais pas

joli en tout cas
05/01/2017, 18h19
Marc-L

Quant tu ouvres un nouveau classeur dans Excel, il est bien ajouté à la collection des classeurs en dernier,
ici c'est identique avec la collection Windows !

Sinon tu restes avec le For Each trouvant la version privée d'IE
avec une probabilité tendant vers l'infini dans le dernier élément de la collection Windows …

Et je suis en Office 32 bits et n'ai aucun souci pour les classes sous IE9 !

Et la clef de la base de registres pointe bien sur la version 32 bits d'IE ‼
(En tout cas de mon côté sur plusieurs PC et différentes versions de Windows …)

1 pièce(s) jointe(s)

re oui normalement la fenêtre est ajoutée en dernier
mais j'avais un doute alors j'ai testé et mes doute se sont confirmés

j'ai ouvert plein de pages IE normale et des dossiers quelconques
j'ai mis des debug pour C a plusieurs endroit
avant le with j'ai donné a la variable "net" la valeur du selon toi le bon IE

j'ai éliminer le ".quit"
et a la fin a ma variable je lui est fait un navigate
résultat 1 coup sur 3 en erreur
je pointe donc ma variable en erreur en dernière ligne avec le curseur et je vois "explorateur Windows" au lieu de "internet explorer"comme dans les deux autre fois ou ca a matché
et regarde le nombre de C dans le debug chez moi c'est toujours 6
voila
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub DemoIEinPrivate() Dim net As Object IE$ = CreateObject("WScript.Shell").RegRead("HKCR\Applications\iexplore.exe\shell\open\command\") With CreateObject("Shell.Application").Windows c& = .Count Debug.Print c If Shell(Replace(IE, "%1", "-private https://www.google.fr/"), vbNormalFocus) Then Debug.Print c While .Count = c: Wend Debug.Print c Set net = .Item(CLng(c)) With .Item(CLng(c)) While .Busy Or .ReadyState < 4: Wend Sleep 1999 '.Quit End With End If End With net.navigate "http://www.developpez.net/forums/d1623067/logiciels/microsoft-office/excel/macros-vba-excel/navigation-internet-privee/" End Sub
pour être sur de chopper la bonne fenêtre il faut employé l'autre object que shell Automation

c'est un débat que j'avais eu avec oliv+ pour son listage des mises a jours Windows je viens de m'en souvenir

en effet l'un liste toutes les fenêtres (IE/explorateur) et l'autre que les IE
je vais rechercher ca

re

Citation:

Et la clef de la base de registres pointe bien sur la version 32 bits d'IE ‼
(En tout cas de mon côté sur plusieurs PC et différentes versions de Windows …)

pas chez moi et ca je n'ai rien touché
Pièce jointe 232458

après toute la librairie n'est pas en rade seulement quelques fonctions et constantes comme on avait le problème avant avec createobject("internetexplorer.application") souvient toi
problème que perso je n'est plus depuis quelques mises a jours office va savoir les quelles

Déjà ta ligne de code n°20 est mal placée, elle doit être logiquement au sein du If …
Et puis comme je verrouille déjà l'élément, je n'ai même pas besoin d'une variable objet !

Sinon de mon côté aucun souci j'ai toujours les mêmes valeurs affichées via les Debug.Print et pour cause ! :ptdr:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub DemoIEinPrivatePourPatrick() Dim net As Object IE$ = CreateObject("WScript.Shell").RegRead("HKCR\Applications\iexplore.exe\shell\open\command\") With CreateObject("Shell.Application").Windows C& = .Count Debug.Print C If Shell(Replace(IE, "%1", "-private https://www.google.fr/"), vbNormalFocus) Then Debug.Print C While .Count = C: Wend Debug.Print C With .Item(CLng(C)) While .Busy Or .ReadyState < 4: Wend Sleep 999 .Navigate "http://www.developpez.net/forums/d1623067/logiciels/microsoft-office/excel/macros-vba-excel/navigation-internet-privee/" While .Busy Or .ReadyState < 4: Wend Sleep 1999 .Quit End With End If End With End Sub
Regarde donc le code du post #17 (en particulier la ligne n°12), il n'est pourtant pas de moi mais dans le même esprit …

Par contre pour la base de registre pointant directement sur la version 64 bits
je ne l'ai jamais rencontré ou je ne l'ai jamais constaté car pas eu de souci …

Dans ton cas, tu lances avec le Run et pour blinder professionnellement
tu vérifies le statut avant de continuer (cf doc MSDN du Run) …

re
j'y comprends plus rien
j'ai donc retrouvé la référence
et elle aussi me liste toutes les fenêtres alors que l'une c'est Microsoft internet control et l'autre la shell control and automation

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test()
'activer la references  “Microsoft Internet Controls” earlybinding
    Dim shellWins1 As SHDocVw.ShellWindows
    Set shellWins1 = New SHDocVw.ShellWindows
    For Each IEwindow In shellWins1
        Debug.Print IEwindow.LocationName
    Next
    Debug.Print "*******************************"
    'utilisation de la librairie microsoft shel et control and automation en late binding
    Dim objShell As Object, obj As Object
    Set objShell = CreateObject("shell.application")
    For Each IEwindow In objShell.Windows
        Debug.Print IEwindow.LocationName
    Next
End Sub

c'est fou ca la première n'a rien a voir avec l'explorer Windows pourtant si oliv serait la il en rigolerait

Voilà le nouveau code de mon côté, en reprenant le post 18.
Je vous en livre un peu plus; le but n'est bien sûr pas d'aller sur google, mais de récupérer un tableau situé sur une page à laquelle on accède en entrant des identifiants sur un pop up "Sécurité de Windows".

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
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetWindow Lib "User32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetKeyState Lib "User32" (ByVal nVirtKey As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds&)
 
Public Const VK_NUMLOCK = &H90
Public Const GW_HWNDNEXT = 2
 
Sub macro()
 
IE = CreateObject("WScript.Shell").RegRead("HKCR\Applications\iexplore.exe\shell\open\command\")
 
With CreateObject("Shell.Application").Windows
    c& = .Count
    If Shell(Replace(IE, "%1", "-private https://le_site_en_question"), vbNormalFocus) Then
        While .Count = c:  Wend
        If Not WaitConnexion(5) Then
            'on se garde 5s pour que le pop up de connexion apparaisse - s'il n'apparait pas au bout de 5s, on continue la macro (par exemple, on peut être dans le cas où la connexion a été établie sans qu'il soit besoin d'entrer les identifiants) - si c'est un problème de lenteur, on va avoir une erreur, d'où le Goto jump plus bas (c'est pas terrible, je sais)
            'les 4 sous-macros ci-dessous permettent de lancer les Sendkeys pour piloter le pop up
            ident1 'tape le login
            ident2 'tape TAB pour passer au champ du mot de passe
            ident3 'tape le mot de passe
            ident4 'tape Entrée
            If GetKeyState(VK_NUMLOCK) <> 1 Then SendKeys "{NUMLOCK}", True 'pour réactiver le pavé numérique si besoin
        End If
 
        With .Item(CLng(c))
            While .Busy Or .ReadyState < 4:  Wend
 
            Dim IEdoc As HTMLDocument, ieTable
            Set IEdoc = .document
            Set ieTable = IEdoc.getElementsByClassName("tab-workdesk").Item(0) 'on trouvele tableau à partir du nom de la classe
 
            On Error GoTo jump
            Dim Cible As String, i, j, k
 
            'boucle sur toutes les lignes du tableau
            For i = 1 To ieTable.Rows.Length
                'boucle sur les cellules dans chaque ligne
                For j = 1 To ieTable.Rows(i - 1).Cells.Length
                    Cible = ieTable.Rows(i - 1).Cells(j - 1).innerText
                    'etc. je passe le traitement des boutons dont je récupère le texte
 
                    Cells(i, j).Value = Cible 'dans Excel, on recopie le tableau cellule par cellule
                Next j
            Next i
 
            Sleep 1999
            .Quit
        End With
    End If
End With
 
jump:
End Sub
 
Public Function WaitConnexion(pTimeOut As Long) As Boolean
' Attend que le pop up de connexion soit chargé
' pTimeOut est un time out en secondes (WaitConnexion vaut True si Timeout)
Dim lhWndP As Long
Dim lTimer As Double
lTimer = Timer
Do
    DoEvents
    If GetHandleFromPartialCaption(lhWndP, "Sécurité de Windows") = True Then Exit Do
    If pTimeOut > 0 And Timer - lTimer > pTimeOut Then 'si on a dépassé les 5s, on sort
        WaitConnexion = True
        Exit Do
    End If
Loop
End Function
 
Public Function GetHandleFromPartialCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean
 
    Dim lhWndP As Long
    Dim sStr As String
    GetHandleFromPartialCaption = False
    lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
    Do While lhWndP <> 0
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        GetWindowText lhWndP, sStr, Len(sStr)
        sStr = Left$(sStr, Len(sStr) - 1)
        If InStr(1, sStr, sCaption) > 0 Then
            GetHandleFromPartialCaption = True
            lWnd = lhWndP
            Exit Do
        End If
        lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
    Loop
 
End Function

06/01/2017, 10h30
Oliv-

Citation:

Envoyé par patricktoulon

re

c'est fou ca la première n'a rien a voir avec l'explorer Windows pourtant si oliv serait la il en rigolerait

:ptdr:
HAHAHA
06/01/2017, 11h41
patricktoulon
re

et voila on parle du loup on en vois le nez :ptdr::ptdr:
salut oliv j'ai réessayé les deux et maintenant ils font la même chose va savoir toi hein !!!

re
@yoyof
ton popup de sécurité c'est quoi son titre de caption en entier
et quoi que la encore on pourrait simplifié avec la méthode de Marc avec le ".count des fenêtre " puisque dans les variable locales on peut voir par exemple obj.HWND je pense que l'on peut voir celui ci aussi
un truc dans le style
Code:

1 2 3 4 5 6 for each fenetre in l'objectshel.Windows if instr(fenetre.locationName,"secutité Windows")>0 then fen=fenetre handle=fen.HWND end if next
mètre cela dans un do loop et c'est tout non???
06/01/2017, 11h59
yoyof

@Patrick

Citation:

ton popup de sécurité c'est quoi son titre de caption en entier

C'est Sécurité de Windows.

Pour la petite histoire, l'apparition de ce pop-up fait perdre la main (tout du moins temporairement) sur la fenêtre principale.

La solution que je présente fonctionne, mais bien sûr elle est contraignante (notamment à cause de la durée de 5s pendant laquelle le pop-up doit apparaître).

On voit une vue de ce pop-up dans ce fil: http://www.developpez.net/forums/d14...hentification/

Merci à toi.

1 pièce(s) jointe(s)

voila une demo en image qui de montre que sans les apis on peut trouver le handle des fenêtres
j'était comme toi avant je fesait un find puis un getnextwindows dans un do loop
maintenant tu pourrait juste essayé cette méthode dans un do loop aussi tant que la fenêtre n'est pas choppé
regarde bien la ligne en bleue dans les variables locales
Code:

1 2 3 4 5 6 7 8 9 SSub test() ' activer la reference "microsoft internet control" Dim win As SHDocVw.ShellWindows Set win = New SHDocVw.ShellWindows For Each fenetre In win Debug.Print fenetre.LocationName & " handle : " & fenetre.Hwnd 'ici tu peut chercher le location name dans une condition et voila tu a ton handle avec l'api showwindow tu peut activer agrandir etc...... Next End Sub
Pièce jointe 232567

ca simplifie la manœuvre non?
plutôt que ta fonction de recherche

tu n'a cas faire le test arrêter ton code au moment d'attendre ta fenêtre securité et lancer cette sub et voir dans les variables locales si tu le choppe pas ce handle

voili voilou

06/01/2017, 12h39
yoyof

Patrick,

j'ai entré l'URL du site dans Internet Explorer, ce qui a fait apparaître le pop up. Ensuite, en laissant tel quel, j'ai fait tourné ta macro avec F8... et la macro voit tout sauf le pop-up... :(

re
pourrait on avoir cette adresse sans mot de passe bien entendu comme ca je teste il me faut juste l'apparition de cette dite fenêtre
le popup n'est peut être pas une fenêtre Windows mais un fils de IE comme le bandeau classique de téléchargement IE

re a oui cette fentre n'apparait pas souvent

alors c'est tout simple

je ferais comme ca
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub test() 'blablablabla..... If fenetre_securite = True Then 'ident1 'ident2 'etc..... Else 'msgbox "delai dépasser verifier votre debit" '.... End If End Sub
Code:

1 2 3 4 5 6 7 8 Function fenetre_securite() As Boolean Handle = 0 t = Timer Do Handle = FindWindow(vbNullString, "Sécurité de Windows") Loop Until Handle <> 0 Or Timer - t > 10 If Handle <> 0 Then fenetre_securite = True End Function

06/01/2017, 13h55
yoyof

Effectivement, ça semble bien fonctionner, merci

Je t'envoie l'adresse par message privé.

1 pièce(s) jointe(s)

re
teste ca dans un classeur vierge

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
 
 
'exemple yoyof
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds&)
Sub DemoIEinPrivate()
    Dim temps As Long
    IE$ = CreateObject("WScript.Shell").RegRead("HKCR\Applications\iexplore.exe\shell\open\command\")
    With CreateObject("Shell.Application").Windows
        c& = .Count
        If Shell(Replace(IE, "%1", "-private http://truc bidule"), vbNormalFocus) Then
            While .Count = c: Wend
            With .Item(CLng(c))
                While .Busy Or .readyState < 4: Wend
                If fenetre_securite(10) = True Then ' pour 10 secondes de delai avant abandon (remplacer 10 par ce qu'on veut slon la tolerance de l'utilisateur )
                    tape_les_touche
                Else
                    MsgBox "temps depassé vérifier le debit "
                End If
                '.Quit
            End With
        End If
    End With
End Sub
 
Function fenetre_securite(TP) As Boolean
    Handle = 0
    T = Timer
    Do
        DoEvents
        Handle = FindWindow(vbNullString, "Sécurité de Windows")
        If Timer - T > TP Then Exit Do
    Loop Until Handle <> 0
    If Handle <> 0 Then fenetre_securite = True
End Function
 
Function tape_les_touche()
    With CreateObject("wscript.shell")
        Sleep 50: .SendKeys (" monlogin")
        Sleep 100: .SendKeys "{TAB}"
        Sleep 100: .SendKeys ("mon mot de passe ")
        Sleep 100: .SendKeys "{TAB}{TAB}"
        Sleep 50: .SendKeys "{ENTER}"
    End With
End Function

apres cette fenetre viens bien avant le ready state 4 de l'item(IE) on peut donc penser que le while busy et ready peut etre placer apres cette operation
dans le if fentre_securite true justeapres travailler le document c'est tout

Pièce jointe 232600

06/01/2017, 16h14
yoyof

Merci Patrick. Par contre, j'ai l'impression que la ligne 14 est à supprimer.

En effet, tant que le pop-up est affiché, la page est en cours de chargement, du coup le code bloque dessus.

En mettant la ligne 14 en commentaires, chez moi ça fonctionne.

Merci à toi

et oui c'est ce que je dis de faire entre le code et la capture dans mon dernier post deplacer le while apres le if fenetre_securité
en fait le busy et ready ne passe pas a 4 a mon avis tant que l'on est pas loguer

ensuite j'ai regarder l'exploitation du document perso si je dois tout prendre la table je fait comme ca

change la sub demo pour celle la et garde les fonction tel quel je te l'es ai donnés

regarde comment je capture la table de la ligne 15 a 22

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
 
Sub DemoIEinPrivate()
    Dim temps As Long
    IE$ = CreateObject("WScript.Shell").RegRead("HKCR\Applications\iexplore.exe\shell\open\command\")
    With CreateObject("Shell.Application").Windows
        c& = .Count
        If Shell(Replace(IE, "%1", "-private https://teletubies"), vbNormalFocus) Then
            While .Count = c: Wend
            With .Item(CLng(c))
                If fenetre_securite(10) = True Then    ' pour 10 secondes de delai avant abandon (remplacer 10 par ce qu'on veut slon la tolerance de l'utilisateur )
                    tape_les_touche
                    While .Busy Or .readyState < 4: Wend
                    '............................
                    'explotation du document ici
                    Dim IEdoc As HTMLDocument, ieTable
                    Set IEdoc = .document
                    ieTableouter = IEdoc.getElementsByClassName("tab-workdesk").Item(0).outerHTML    'on trouvele tableau à partir du nom de la classe
                    With CreateObject("htmlfile")
                        faire = .parentWindow.clipboardData.setData("text", ieTableouter)
                        With Sheets(1): .Range("A1:Z" & Rows.Count).Clear: .Cells(1, 1).Select: .Paste: End With
                        faire = .parentWindow.clipboardData.clearData("text")
                    End With
                End With
            .Quit
            End With
            '............................
        Else
            MsgBox "temps depassé vérifier le debit "
        End If
        On Error Resume Next
        .Quit
    End With
End If
End With
End Sub

06/01/2017, 17h05
Marc-L

Yoyof,

ne pas utiliser les SendKeys du VBA (oui, il y en a deux) mais celui de Windows

via par exemple CreateObject("WScript.Shell").SendKeys rendant inutile la ligne n°26 de ton code du post #27 …

re
@marcL
j'ai remplacer tout son tointoin avec les apis par un simple findwidow dans un do loop avec un delay variable pour l'abandon

et son ident 1,2,3,4
par le simple tape_touche

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Function fenetre_securite(TP) As Boolean
    Handle = 0
    T = Timer
    Do
        DoEvents
        Handle = FindWindow(vbNullString, "Sécurité de Windows")
        If Timer - T > TP Then Exit Do
    Loop Until Handle <> 0
    If Handle <> 0 Then fenetre_securite = True
End Function
 
Function tape_les_touche()
    With CreateObject("wscript.shell")
        Sleep 50: .SendKeys (" monlogin")
        Sleep 100: .SendKeys "{TAB}"
        Sleep 100: .SendKeys ("mon mot de passe ")
        Sleep 100: .SendKeys "{TAB}{TAB}"
        Sleep 50: .SendKeys "{ENTER}"
    End With
End Function

Messieurs, merci pour votre aide, je viens de voir vos réponses (sans prendre le temps de les étudier).
J'y jette un oeil lundi si je le peux.

En attendant, je vous souhaite un bon week-end. :D

EDIT
J'ai quand même tenté.
Ça fonctionne, sauf pour la mise en forme du tableau. En effet, elle est un peu spéciale avec des boutons contenant du texte (du coup, on a des boutons importés mais dont le positionnement n'est pas génial).
Ce que je faisais jusqu'alors, c'était de prendre le texte de chaque cellule concaténé à celui du bouton de la cellule quand il y en a un.

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
Dim Cible As String, i, j, k
'boucle sur toutes les lignes du tableau
For i = 1 To ieTable.Rows.Length
    'boucle sur les cellules dans chaque ligne
    For j = 1 To ieTable.Rows(i - 1).Cells.Length
        Cible = ieTable.Rows(i - 1).Cells(j - 1).innerText
        If ieTable.Rows(i - 1).Cells(j - 1).Children.Length >= 1 Then 'je regarde s'il y a des children (dont sont les boutons)
            For k = 1 To ieTable.Rows(i - 1).Cells(j - 1).Children.Length
                If ieTable.Rows(i - 1).Cells(j - 1).Children.Item(k - 1).className = "button" Then
                    Cible = Cible & " " & ieTable.Rows(i - 1).Cells(j - 1).Children.Item(k - 1).Value
                End If
            Next
        End If
        Cells(i, j).Value = Cible
        If i = 1 And j = 8 Then 'il y a une fusion de cellules dans l'en-tête
            With Range(Cells(i, j), Cells(i, j + 3))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            Range(Cells(i, j), Cells(i, j + 3)).Merge
        End If
    Next j
Next i

Voir 40 message(s) de cette discussion en une page