Avertissement de péremption de compte

Grâce à une autre question plus bas, j'ai trouvé la réponse :

http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1
021.mspx

Voilà le résultat adpaté pour moi (intitulé du compte unique car mono forêt, mono domaine) :

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
 
On Error Resume Next
 
Const ADS_SCOPE_SUBTREE = 2
 
' Déclaration des variables
Dim objRoot,objConnection,objCommand
Dim strDNC,strSamAccount,strDistinguishedSamAccount
 
' Initialisation de l'objet ROOT du domaine
Set objRoot = GetObject("LDAP://RootDSE")
strDNC = objRoot.Get("DefaultNamingContext")
 
' Initialisation du intituleé du compte d'ouverture de session 
strSamAccount=Environ("USERNAME")
 
 
'Recherche du DistinguishedName du compte d'ouverture de session 
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
objCommand.CommandText = _
    "SELECT distinguishedName FROM 'LDAP://"&strDNC&"' WHERE objectCategory='user' " & _
        "AND sAMAccountName='"&strSamAccount&"'"
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst
strDistinguishedSamAccount=objRecordSet.Fields("distinguishedName").Value
AnalyseExpiration
 
Function Environ(VarName)
    Dim wss, env
    Set wss = CreateObject("WScript.Shell")
    Set env = wss.environment("process")
    Environ = env(VarName)
    If Environ = "" Then
        Set env = wss.environment("system")
        Environ = env(VarName)
    End If
End Function
 
Function AnalyseExpiration
	Dim objUser
 
	Set objUser = GetObject("LDAP://"&strDistinguishedSamAccount)
	If round(objUser.AccountExpirationDate-Now)< 15 Then
		MsgBox "Votre compte bureautique """&strSamAccount&""" est paramétré avec une date d'expiration dans moins de 15 jours."&Chr(13)&Chr(10)&_
		"Merci de déclencher dès maintenant une demande de prolongation si vous devez l'utiliser au delà de cette date."&Chr(13)&Chr(10)& Chr(13) & Chr(10)&_
		"En vous remerciant de votre collaboration.",vbExclamation+vbOKOnly,"MESSAGE D'AVERTISSEMENT ..."
	End If
End Function

Merci à celui qui a donner la réponse pour le post ci-dessous !