Bonjour,

j'ai un ancien script qui tourne à chaque ouverture de session des utilisateurs pour remplacer le nom d'utilisateur office par le login windows.

Entre temps, j'ai quelques postes qui sont passés en windows 8 et depuis, le nom de l'utilisateur ayant ouvert un fichier partagé ne s'affiche plus ("le fichier xxx est vérouillé pour modification ...").

je pense donc que cela vient du fait que le registre windows 8 n'est pas bâti comme celui de XP et qu'il faut modifier le script que voici :

Qu'en pensez-vous ?

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
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
'office.vbs version 2.00
'
'script de modification du nom enregistré dans office par le nom de login windows de l'utilisateur
'Vérification de la version office installée
'modification par supresssion et modification de la clef registre "HKCU\Software\Microsoft\Office\x.0\Common\UserInfo\UserName"
'traces des modifications effectuées dans le fichier office.log situé sous \\serveur\partage
On error resume next 
'déclaration des variables
Dim wscr, WshShell, tempread, key, valhex
Dim refRegistry, arrValueData, strValueData, strSKPath, strValueName, i
Dim oFSys, Filelog
Dim sResult, sNomOffice, sOfficeVer, sVersionOffice
'déclaration des objets
Set wscr = CreateObject("wscript.shell")
Set netw = CreateObject("WScript.Network")
Set objWord = CreateObject("Word.Application")
Set oFSys = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
'déclaration constante
Const HKEY_CURRENT_USER = &H80000001
Const strComputer = "."
 sRegHKCU="HKCU\"
 sregHKLM="HKLM\"
 sRegCommun="SOFTWARE\Microsoft\Office\"
 sregPost1="\Common\UserInfo"
 sRegPost = "\Common\InstallRoot\"
 strValueName = "UserName"
 
'HKLM\SOFTWARE\Microsoft\Office\12.0\Common\InstallRoot   ' Office 2007 
'HKLM\SOFTWARE\Microsoft\Office\11.0\Common\InstallRoot   ' Office 2003 
'HKLM\SOFTWARE\Microsoft\Office\10.0\Common\InstallRoot   ' Office 2002 (XP) 
'HKLM\SOFTWARE\Microsoft\Office\9.0\Common\InstallRoot    ' Office 2000 
'HKLM\SOFTWARE\Microsoft\Office\8.0\Common\InstallRoot    ' Office 97 
Function GetOfficeVer() 
 
  Select Case True 
    Case RegKeyExists(sRegPre & "12.0" & sRegPost) 
      sOfficeVer = "12.0" 
      sVersionOffice = "Office 2007"
Case RegKeyExists(sRegPre & "11.0" & sRegPost) 
      sOfficeVer = "11.0" 
      sVersionOffice = "Office 2003"
    Case RegKeyExists(sRegPre & "10.0" & sRegPost) 
      sOfficeVer = "10.0"
      sVersionOffice = "Office 2002"
    Case RegKeyExists(sRegPre & "9.0" & sRegPost) 
      sOfficeVer = "9.0"
      sVersionOffice = "Office 2000"
    Case RegKeyExists(sRegPre & "8.0" & sRegPost) 
      sOfficeVer = "8.0" 
      sVersionOffice = "Office 97"
 
 
    Case Else 
      sOfficeVer = "pas d'office"
      sVersionOffice = "pas d'office"
 
  End Select 
     GetOfficeVer= sOfficeVer
     End Function 
Function RegKeyExists(ByVal sRegKey) 
  ' Returns True or False based on the existence of a registry key. 
  Dim sDescription, oShell 
  Set oShell = CreateObject("WScript.Shell") 
   RegKeyExists = True 
   sRegKey = Trim (sRegKey) 
   If Not Right(sRegKey, 1) = "\" Then 
   sRegKey = sRegKey & "\" 
 
 
  End If 
  On Error Resume Next 
  oShell.RegRead "HKEYNotAKey\" 
  sDescription = Replace(Err.Description, "HKEYNotAKey\", "") 
  Err.Clear 
  oShell.RegRead sRegKey 
  RegKeyExists = sDescription <> Replace(Err.Description, sRegKey, "") 
  On Error Goto 0
 
End Function 
 'declaration des chaines clef de registre
   sRegPre = sregHKLM & sRegCommun ' "HKLM\SOFTWARE\Microsoft\Office\" 
 
   strSKPath =  sRegCommun & GetOfficeVer & sregPost1 '"Software\Microsoft\Office\9.0\Common\UserInfo"
 
   key =  sRegHKCU & strSKPath &  "\" & strValueName   '"HKCU\Software\Microsoft\Office\9.0\Common\UserInfo\UserName"
 'Lecture des données utilisateur et test d'égalité pour ne pas faire de modification si username =user office
 
 Sub LoginUtilisateur
 'WScript.Echo "Version office installée : " & sOfficeVer
 
 sNomOffice = objWord.UserName
 If netw.UserName=objWord.UserName Then Call Fichier
End Sub
'Transformation du nom login utilisateur en chaine hexa pour la clef office  
Sub ASCIIHEXA
Dim aAscii()
Dim aChaine() 
Dim iLenChaine
Dim k
Dim aHexa()
sChaine = netw.UserName
sResult = "" 
' taille
iLenChaine = Len(sChaine) 
' la chaine en tableau
ReDim aChaine(iLenChaine) 'premiere valeur null non utilisée... indice 0
For k = 1 To iLenChaine 
aChaine(k) = Mid(sChaine, k, 1) 
Next  
' ascii integer en tableau
 
ReDim aAscii(iLenChaine) 
For k = 1 To iLenChaine 
aAscii(k) = Asc(aChaine(k)) 
Next  
' ascii hexa en tableau + result
 
ReDim aHexa(iLenChaine) 
For k = 1 To iLenChaine 
aHexa(k) = Hex(aAscii(k)) 
sResult = sResult & CStr(aHexa(k)) & "-00-" 
Next  
' on ajoute le dernier chr(0)
sResult = sResult & "00-00" 
End Sub
'Lecture de la clef de registre pour user office
Sub lecture
Set refRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
		If refRegistry.GetBinaryValue(HKEY_CURRENT_USER, strSKPath , strValueName, arrValueData) = 0 Then
					For i = LBound(arrValueData) to UBound (arrValueData)
					strValueData = strValueData & Right("00" & Hex(arrValueData(i)),2) & "-"
					Next
						strValueData = Left(strValueData, Len(strValueData) - 1)
		Else
					Call Fichier
		End If
Set refRegistry = Nothing
End Sub
'Ecriture base de registre et fichier log
Sub Fichier
'cas egalité username et user office
	If netw.UserName=objWord.UserName Then
			Set FileLog = oFSys.OpenTextFile("c:\office.log", 8, True)
			FileLog.writeLine ("PC :" & netw.ComputerName & " Nom utilisateur :" & netw.UserName & " Nom office :" & objWord.UserName & " Compte Identique" & "; Version office : " & sVersionOffice)
			FileLog.close
      Exit Sub
		End If
 
'cas différence username et user office
If netw.UserName <> objWord.UserName Then
WshShell.RegDelete key
	        Dim refRegistry, arrValueData, strValueData, l, k
          ReDim arrValueData(Len(sResult)* 2 + 1)
 
             k = 0 
             For l = 1 To Len(sResult)
             		arrValueData(k) = Asc(Mid(sResult,l,1))
             		k = k + 1
              	arrValueData(k) = 0
             			k = k + 1
            Next
				arrValueData(k) = 0
				k = k + 1
				arrValueData(k) = 0
			Set refRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
			refRegistry.SetBinaryValue HKCU, strSKPath, strValueName, arrValueData
			Set refRegistry = Nothing
'Ecriture fichier log sur c:\
 
			Set FileLog = oFSys.OpenTextFile("c:\office.log", 8, True)
			FileLog.writeLine ("PC :" & netw.ComputerName & " Nom utilisateur :" & netw.UserName & " Nom office :" & sNomOffice & " Modification effectuée" & "; Version office : " & sVersionOffice)
			FileLog.close
 
Set netw = Nothing
Set objWord =Nothing
Set oFSys = Nothing
Set WshShell =	Nothing	
Set FileLog= Nothing	
End If
End Sub
'procédure principale
LoginUtilisateur
ASCIIHEXA
Lecture 
Fichier