Discussion :

[franckb74]

Bonjour,

Je souhaiterai masquer la saisie du mot de passe que je saisi à l'ouverture d'Outlook et remplacer le mot de passe lorsque je le saisi par : ******
Voici le code VBA :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Application_Startup()
    Dim i As Integer
    Dim pass As String
    Dim chaine As String
    i = 0
    chaine = "monmotdepasse"    'mot clé
    While i < 3 And pass <> chaine    'Boucle tant que mauvais mot de passe ou moins de 3 essais
        pass = InputBox("saisissez le mot de passe")    'récupérer le mot de passe saisi
        i = i + 1
    Wend
    If pass <> chaine And i >= 3 Then
        Application.Quit    'Quitter l'application
    End If
End Sub

Que dois-je modifier dans mon code ?

Merci pour votre aide !

[Oliv-]

Bonjour,
Il faut utiliser un userform , avec un Textbox qui aura sa propriété PasswordChar = *

[franckb74]

Bonjour,

Pour pour l'info

Par contre je ne vois pas comment intégrer ce "Textbox" dans mon code.

Voici l'aperçu de mon code dans Outlook :

[Oliv-]

un truc dans ce genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub Application_Startup()
 
userform1.show
 
end sub

DAns un userform (userform1) avec un bouton (CommandButton1) et un textbox (textbox1)

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
  Sub CommandButton1_click()
    Static i As Integer
    Dim pass As String
    Dim chaine As String
 
    chaine = "monmotdepasse"    'mot clé
    While i < 3 And Me.TextBox1.Value <> chaine    'Boucle tant que mauvais mot de passe ou moins de 3 essais
    MsgBox i
        i = i + 1
        Exit Sub
 
    Wend
    If Me.TextBox1.Value <> chaine And i >= 3 Then
        Application.Quit    'Quitter l'application
    End If
 
    End Sub
 
 
Private Sub UserForm_Initialize()
 i = 0
End Sub

[franckb74]

Rebonjour,

Merci pour cette proposition de code

Par contre je ne vois pas comment paramétrer la boite de dialogue qui s'ouvre à l'ouverture d'Outlook.

Voici la boite de dialogue :

[Oliv-]

c'est toi qui l'a faite cette boite de dialogue ?

[franckb74]

Non je ne suis pas assez calé en VBA

[Oliv-]

As tu dans ton projet VBA des userform/feuilles ? çà doit être l'une d'elle

[franckb74]

Non je n'ai que ce qui est affiché ci-dessous :

[Oliv-]

AJ oui je comprends en fait il faut remplacer le code qui est dans ThisOutlookSession par celui que je t'ai donné

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub Application_Startup()
 
userform1.show
 
end sub

il faut créer un userform en cliquant dans la fenetre de code sur Insertion/Userform

ensuite ajoute des contrôles avec la boite qui va bien

http://silkyroad.developpez.com/VBA/UserForm/

[franckb74]

merci pour ta réponse mais je sais pas quoi faire ensuite.

merci tout de même

[franckb74]

J'ai fini par trouver sur un autre forum la solution à mon problème.

Afin de pouvoir masquer la saisie dans mon InputBox j'ai trouvé un code qui ajoute cette fonctionnalité à cette fonction qui ne comprend pas cette option nativement.

J'ai inséré dans un nouveau module le code suivant et ai remplacé la fonction de InputBox par InputBoxDK et ça fonctionne tip top !

Le code à insérer dans un module :

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
Option Explicit
'Code geschrieben von Daniel Klann
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
 
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, lngBuffer As Long
If lngCode < HC_ACTION Then
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
 If lngCode = HCBT_ACTIVATE Then
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
 End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function
 
Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As Long, lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function

Et voilà le résultat :