[Léger HS] Script VB ?

papou

05/01/2006 à 18:00

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et ce
sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base de
registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et ce
sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base de
registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et ce
sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base de
registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Jacques93

05/01/2006 à 18:25

Bonjour john et papou

Je crains, sans avoir testé, que la méthode de papou ne pose un petit
problème (sous 2003 en tout cas). La valeur qui stocke le nom
d'utilisateur office :

HKEY_CURRENT_USERSoftwareMicrosoftOffice11.0CommonUserInfo

UserName est de type REG_BINARY, cad que le nom est stocké en Unicode,
et avec la méthode RegWrite, on est limité aux String et au Integer:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp
(font des url de plus en plus simple chez MS)

Par contre si on écrit une clé de type REG_SZ, Excel (ou Word),
reconnait une clé invalide, et propose le nom de login comme nom
d'utilisateur.

Tu peux donc, peut être, te contenter de supprimer cette valeur avec la
méthode RegDelete :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et ce
sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base de
registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

--
Cordialement,

Jacques.

Bonjour john et papou

Je crains, sans avoir testé, que la méthode de papou ne pose un petit
problème (sous 2003 en tout cas). La valeur qui stocke le nom
d'utilisateur office :

HKEY_CURRENT_USERSoftwareMicrosoftOffice11.0CommonUserInfo

UserName est de type REG_BINARY, cad que le nom est stocké en Unicode,
et avec la méthode RegWrite, on est limité aux String et au Integer:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp
(font des url de plus en plus simple chez MS)

Par contre si on écrit une clé de type REG_SZ, Excel (ou Word),
reconnait une clé invalide, et propose le nom de login comme nom
d'utilisateur.

Tu peux donc, peut être, te contenter de supprimer cette valeur avec la
méthode RegDelete :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et ce
sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base de
registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

--
Cordialement,

Jacques.

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour john et papou

Je crains, sans avoir testé, que la méthode de papou ne pose un petit
problème (sous 2003 en tout cas). La valeur qui stocke le nom
d'utilisateur office :

HKEY_CURRENT_USERSoftwareMicrosoftOffice11.0CommonUserInfo

UserName est de type REG_BINARY, cad que le nom est stocké en Unicode,
et avec la méthode RegWrite, on est limité aux String et au Integer:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp
(font des url de plus en plus simple chez MS)

Par contre si on écrit une clé de type REG_SZ, Excel (ou Word),
reconnait une clé invalide, et propose le nom de login comme nom
d'utilisateur.

Tu peux donc, peut être, te contenter de supprimer cette valeur avec la
méthode RegDelete :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et ce
sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base de
registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

--
Cordialement,

Jacques.

papou

06/01/2006 à 08:44

Bonjour
C'est exact, le type de clé est REG_BINARY.
Dans ces conditions, John peut faire un script comme ceci :

Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Set Appxl = WScript.CreateObject("Excel.Application")
Appxl.UserName=LeUser
set WshNetWork = Nothing
Set Appxl = Nothing

Cordialement
Pascal

"Jacques93" a écrit dans le message de news:

Bonjour john et papou

Je crains, sans avoir testé, que la méthode de papou ne pose un petit
problème (sous 2003 en tout cas). La valeur qui stocke le nom
d'utilisateur office :

HKEY_CURRENT_USERSoftwareMicrosoftOffice11.0CommonUserInfo

UserName est de type REG_BINARY, cad que le nom est stocké en Unicode, et
avec la méthode RegWrite, on est limité aux String et au Integer:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp
(font des url de plus en plus simple chez MS)

Par contre si on écrit une clé de type REG_SZ, Excel (ou Word), reconnait
une clé invalide, et propose le nom de login comme nom d'utilisateur.

Tu peux donc, peut être, te contenter de supprimer cette valeur avec la
méthode RegDelete :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et
ce sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base
de registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

--
Cordialement,

Jacques.

Bonjour
C'est exact, le type de clé est REG_BINARY.
Dans ces conditions, John peut faire un script comme ceci :

Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Set Appxl = WScript.CreateObject("Excel.Application")
Appxl.UserName=LeUser
set WshNetWork = Nothing
Set Appxl = Nothing

Cordialement
Pascal

"Jacques93" <jacques@Nospam> a écrit dans le message de news:
enKrK0hEGHA.2036@TK2MSFTNGP14.phx.gbl...

Bonjour john et papou

Je crains, sans avoir testé, que la méthode de papou ne pose un petit
problème (sous 2003 en tout cas). La valeur qui stocke le nom
d'utilisateur office :

HKEY_CURRENT_USERSoftwareMicrosoftOffice11.0CommonUserInfo

UserName est de type REG_BINARY, cad que le nom est stocké en Unicode, et
avec la méthode RegWrite, on est limité aux String et au Integer:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp
(font des url de plus en plus simple chez MS)

Par contre si on écrit une clé de type REG_SZ, Excel (ou Word), reconnait
une clé invalide, et propose le nom de login comme nom d'utilisateur.

Tu peux donc, peut être, te contenter de supprimer cette valeur avec la
méthode RegDelete :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et
ce sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base
de registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

--
Cordialement,

Jacques.

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour
C'est exact, le type de clé est REG_BINARY.
Dans ces conditions, John peut faire un script comme ceci :

Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Set Appxl = WScript.CreateObject("Excel.Application")
Appxl.UserName=LeUser
set WshNetWork = Nothing
Set Appxl = Nothing

Cordialement
Pascal

"Jacques93" a écrit dans le message de news:

Bonjour john et papou

Je crains, sans avoir testé, que la méthode de papou ne pose un petit
problème (sous 2003 en tout cas). La valeur qui stocke le nom
d'utilisateur office :

HKEY_CURRENT_USERSoftwareMicrosoftOffice11.0CommonUserInfo

UserName est de type REG_BINARY, cad que le nom est stocké en Unicode, et
avec la méthode RegWrite, on est limité aux String et au Integer:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp
(font des url de plus en plus simple chez MS)

Par contre si on écrit une clé de type REG_SZ, Excel (ou Word), reconnait
une clé invalide, et propose le nom de login comme nom d'utilisateur.

Tu peux donc, peut être, te contenter de supprimer cette valeur avec la
méthode RegDelete :

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/678e6992-ddc4-4333-a78c-6415c9ebcc77.asp

Bonjour John
Pas trop le temps mais avec un script VBS c'est tout à fait faisable et
ce sera très léger.
Pour récupérer le nom utilisateur :
Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Ensuite, si je ne me trompe pas il doit y avoir une entrée dans la base
de registre pour le nom d'utilisateur dans Office
Donc il te suffit d'adapter cet exemple :
Set ObjShell = WScript.CreateObject("WScript.Shell")
ObjShell.RegWrite "LaChaineTexteCleRegistreUtilisateur" & LeUser , "",
"REG_DWORD"

Cordialement
Pascal

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,
du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

--
Cordialement,

Jacques.

Jacques93

06/01/2006 à 09:57

Bonjour papou,

c'est pas pour couper les cheveux en quatre, mais la clé étant dans

HKEY_CURRENT_USER

elle ne sera renseigné que pour le compte actif (W2K/XP/2003) au
lancemenent du script. Mais ce n'est peut être pas gênant s'il n'y a
qu'un compte par poste.

Bonjour
C'est exact, le type de clé est REG_BINARY.
Dans ces conditions, John peut faire un script comme ceci :

Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Set Appxl = WScript.CreateObject("Excel.Application")
Appxl.UserName=LeUser
set WshNetWork = Nothing
Set Appxl = Nothing

Cordialement
Pascal

--
Cordialement,

Jacques.

Michel Pierron

07/01/2006 à 23:23

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer & "rootdefault:StdRegProv")
If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer & "rootdefault:StdRegProv")
Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de

l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:\" & sComputer & "rootdefault:StdRegProv")
If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:\" & sComputer & "rootdefault:StdRegProv")
Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de

l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer & "rootdefault:StdRegProv")
If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer & "rootdefault:StdRegProv")
Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la boite)
dans les applications Office. Dans une macro déployée dans 10% des postes
de

l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander de
modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

JohnFuss

09/01/2006 à 10:50

Bonjour,

j'ai fini par écrire ça :

Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Set Appxl = WScript.CreateObject("Excel.Application")
Appxl.UserName=LeUser
set WshNetWork = Nothing
Set Appxl = Nothing
MsgBox "Terminé !"

Je vais regarder ta proposition

John
"Michel Pierron" a écrit dans le message de
news:

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Bonjour,

j'ai fini par écrire ça :

Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Set Appxl = WScript.CreateObject("Excel.Application")
Appxl.UserName=LeUser
set WshNetWork = Nothing
Set Appxl = Nothing
MsgBox "Terminé !"

Je vais regarder ta proposition

John
"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de
news:OoGw9j9EGHA.2064@TK2MSFTNGP09.phx.gbl...

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de

l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,

j'ai fini par écrire ça :

Set WshNetwork = WScript.CreateObject("WScript.Network")
LeUser = WshNetwork.UserName
Set Appxl = WScript.CreateObject("Excel.Application")
Appxl.UserName=LeUser
set WshNetWork = Nothing
Set Appxl = Nothing
MsgBox "Terminé !"

Je vais regarder ta proposition

John
"Michel Pierron" a écrit dans le message de
news:

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

JohnFuss

09/01/2006 à 15:55

Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il un
moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName de
tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" a écrit dans le message de
news:

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il un
moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName de
tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de
news:OoGw9j9EGHA.2064@TK2MSFTNGP09.phx.gbl...

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de

l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il un
moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName de
tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" a écrit dans le message de
news:

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" & "UserName"
Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA"
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Michel Pierron

09/01/2006 à 22:24

Bonsoir John;
1 - Si c'est sur sa propre machine, il suffit d'exécuter le script vbs en
local (dans le script, "." indique l'ordinateur local).
Si c'est sur la machine d'un autre, cela n'a pas d'intérêt car il n'aura
même pas accès à Office si le raccourci de lancement n'est pas placé dans le
groupe AllUsers.
2 - Comme indiqué précédemment, "." indique l'ordinateur local; si tu as la
liste des ordinateurs, il suffit de faire une boucle sur le nom de la macine
en lieu et place de "."

Si tu as les droits nécessaires, tu peux faire tout ça de ton poste en VBA
dans un classeur Excel.
Commence par lister les domaines avec:

Sub AllDomainsList()
Dim nSpace As Object, Domain As Object
Dim Domains As String
Set nSpace = GetObject("WinNT:")
For Each Domain In nSpace
If Len(Domains) Then Domains = Domains & vbLf
Domains = Domains & Domain.Name
Next
MsgBox Domains, 64
End Sub

Ensuite, tu listes les utilisateurs dans le domaine qui t'intéresse avec:

Sub Listing()
Const Domain1 = "Ici le nom du domaine à explorer"
Application.ScreenUpdating = False
Workbooks.Add
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range("A1") = "LOGIN"
Range("B1") = "USER"
Range("C1") = "COMPUTER DESCRIPTION"
Range("A1:C1").Font.Bold = True
Call AllUsersList(Domain1)
Dim i%: i = 2
Do While Cells(i, 1) <> ""
Call UserInfos(Domain1, Cells(i, 1), i)
i = i + 1
Loop
Cells.Columns.AutoFit
End Sub

Sub AllUsersList(sDomain$)
Dim Computer As Object, User As Object
Dim i%: i = 1
Set Computer = GetObject("WinNT://" & sDomain)
Computer.Filter = Array("User")
For Each User In Computer
i = i + 1
Cells(i, 1) = User.Name
Next
Set Computer = Nothing
End Sub

Sub UserInfos(sDomain$, sUser$, ByVal i%)
With GetObject("WinNT://" & sDomain & "/" & sUser & ",user")
Cells(i, 2) = .FullName
Cells(i, 3) = .Description
End With
End Sub

Tu peux utiliser la liste créée pour faire la boucle en excluant
éventuellement les utilisateurs que tu ne veux pas traiter (s'ils ne sont
pas connectés, par exemple).

Pour avoir la liste des machines connectées sur le domaine, tu peux
utiliser:

Sub AllComputersList(sDomain)
Workbooks.Add
Dim Domain As Object, Computer As Object
Dim i%
Set Domain = GetObject("WinNT://" & sDomain)
Domain.Filter = Array("Computer")
For Each Computer In Domain
i = i + 1
Cells(i, 1) = Computer.Name
Next
Set Domain = Nothing
End Sub

Pour te simplifier la vie, tu peux adapter le script vbs en VBA; tu auras
tout en un.

MP

"JohnFuss" a écrit dans le message de news:
dptthj$rmc$

Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il un
moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName de
tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" a écrit dans le message de
news:
Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" &
"UserName"

Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias
"GetTempPathA"

(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Bonsoir John;
1 - Si c'est sur sa propre machine, il suffit d'exécuter le script vbs en
local (dans le script, "." indique l'ordinateur local).
Si c'est sur la machine d'un autre, cela n'a pas d'intérêt car il n'aura
même pas accès à Office si le raccourci de lancement n'est pas placé dans le
groupe AllUsers.
2 - Comme indiqué précédemment, "." indique l'ordinateur local; si tu as la
liste des ordinateurs, il suffit de faire une boucle sur le nom de la macine
en lieu et place de "."

Si tu as les droits nécessaires, tu peux faire tout ça de ton poste en VBA
dans un classeur Excel.
Commence par lister les domaines avec:

Sub AllDomainsList()
Dim nSpace As Object, Domain As Object
Dim Domains As String
Set nSpace = GetObject("WinNT:")
For Each Domain In nSpace
If Len(Domains) Then Domains = Domains & vbLf
Domains = Domains & Domain.Name
Next
MsgBox Domains, 64
End Sub

Ensuite, tu listes les utilisateurs dans le domaine qui t'intéresse avec:

Sub Listing()
Const Domain1 = "Ici le nom du domaine à explorer"
Application.ScreenUpdating = False
Workbooks.Add
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range("A1") = "LOGIN"
Range("B1") = "USER"
Range("C1") = "COMPUTER DESCRIPTION"
Range("A1:C1").Font.Bold = True
Call AllUsersList(Domain1)
Dim i%: i = 2
Do While Cells(i, 1) <> ""
Call UserInfos(Domain1, Cells(i, 1), i)
i = i + 1
Loop
Cells.Columns.AutoFit
End Sub

Sub AllUsersList(sDomain$)
Dim Computer As Object, User As Object
Dim i%: i = 1
Set Computer = GetObject("WinNT://" & sDomain)
Computer.Filter = Array("User")
For Each User In Computer
i = i + 1
Cells(i, 1) = User.Name
Next
Set Computer = Nothing
End Sub

Sub UserInfos(sDomain$, sUser$, ByVal i%)
With GetObject("WinNT://" & sDomain & "/" & sUser & ",user")
Cells(i, 2) = .FullName
Cells(i, 3) = .Description
End With
End Sub

Tu peux utiliser la liste créée pour faire la boucle en excluant
éventuellement les utilisateurs que tu ne veux pas traiter (s'ils ne sont
pas connectés, par exemple).

Pour avoir la liste des machines connectées sur le domaine, tu peux
utiliser:

Sub AllComputersList(sDomain)
Workbooks.Add
Dim Domain As Object, Computer As Object
Dim i%
Set Domain = GetObject("WinNT://" & sDomain)
Domain.Filter = Array("Computer")
For Each Computer In Domain
i = i + 1
Cells(i, 1) = Computer.Name
Next
Set Domain = Nothing
End Sub

Pour te simplifier la vie, tu peux adapter le script vbs en VBA; tu auras
tout en un.

MP

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dptthj$rmc$1@s1.news.oleane.net...

Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il un
moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName de
tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de
news:OoGw9j9EGHA.2064@TK2MSFTNGP09.phx.gbl...

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" &
"UserName"

Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de

l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias
"GetTempPathA"

(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir John;
1 - Si c'est sur sa propre machine, il suffit d'exécuter le script vbs en
local (dans le script, "." indique l'ordinateur local).
Si c'est sur la machine d'un autre, cela n'a pas d'intérêt car il n'aura
même pas accès à Office si le raccourci de lancement n'est pas placé dans le
groupe AllUsers.
2 - Comme indiqué précédemment, "." indique l'ordinateur local; si tu as la
liste des ordinateurs, il suffit de faire une boucle sur le nom de la macine
en lieu et place de "."

Si tu as les droits nécessaires, tu peux faire tout ça de ton poste en VBA
dans un classeur Excel.
Commence par lister les domaines avec:

Sub AllDomainsList()
Dim nSpace As Object, Domain As Object
Dim Domains As String
Set nSpace = GetObject("WinNT:")
For Each Domain In nSpace
If Len(Domains) Then Domains = Domains & vbLf
Domains = Domains & Domain.Name
Next
MsgBox Domains, 64
End Sub

Ensuite, tu listes les utilisateurs dans le domaine qui t'intéresse avec:

Sub Listing()
Const Domain1 = "Ici le nom du domaine à explorer"
Application.ScreenUpdating = False
Workbooks.Add
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range("A1") = "LOGIN"
Range("B1") = "USER"
Range("C1") = "COMPUTER DESCRIPTION"
Range("A1:C1").Font.Bold = True
Call AllUsersList(Domain1)
Dim i%: i = 2
Do While Cells(i, 1) <> ""
Call UserInfos(Domain1, Cells(i, 1), i)
i = i + 1
Loop
Cells.Columns.AutoFit
End Sub

Sub AllUsersList(sDomain$)
Dim Computer As Object, User As Object
Dim i%: i = 1
Set Computer = GetObject("WinNT://" & sDomain)
Computer.Filter = Array("User")
For Each User In Computer
i = i + 1
Cells(i, 1) = User.Name
Next
Set Computer = Nothing
End Sub

Sub UserInfos(sDomain$, sUser$, ByVal i%)
With GetObject("WinNT://" & sDomain & "/" & sUser & ",user")
Cells(i, 2) = .FullName
Cells(i, 3) = .Description
End With
End Sub

Tu peux utiliser la liste créée pour faire la boucle en excluant
éventuellement les utilisateurs que tu ne veux pas traiter (s'ils ne sont
pas connectés, par exemple).

Pour avoir la liste des machines connectées sur le domaine, tu peux
utiliser:

Sub AllComputersList(sDomain)
Workbooks.Add
Dim Domain As Object, Computer As Object
Dim i%
Set Domain = GetObject("WinNT://" & sDomain)
Domain.Filter = Array("Computer")
For Each Computer In Domain
i = i + 1
Cells(i, 1) = Computer.Name
Next
Set Domain = Nothing
End Sub

Pour te simplifier la vie, tu peux adapter le script vbs en VBA; tu auras
tout en un.

MP

"JohnFuss" a écrit dans le message de news:
dptthj$rmc$

Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il un
moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName de
tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" a écrit dans le message de
news:
Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" &
"UserName"

Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur demander
de

modifier à la main leur utilisateur Office. Mais peut-être un vbscript
ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro me
parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias
"GetTempPathA"

(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo, InStr(GetSystemInfo,
Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

JohnFuss

10/01/2006 à 09:23

Merci bcp,

je vais me pencher la-dessus c'est très intéressant.

John

"Michel Pierron" a écrit dans le message de
news:

Bonsoir John;
1 - Si c'est sur sa propre machine, il suffit d'exécuter le script vbs en
local (dans le script, "." indique l'ordinateur local).
Si c'est sur la machine d'un autre, cela n'a pas d'intérêt car il n'aura
même pas accès à Office si le raccourci de lancement n'est pas placé dans
le

groupe AllUsers.
2 - Comme indiqué précédemment, "." indique l'ordinateur local; si tu as
la

liste des ordinateurs, il suffit de faire une boucle sur le nom de la
macine

en lieu et place de "."

Si tu as les droits nécessaires, tu peux faire tout ça de ton poste en VBA
dans un classeur Excel.
Commence par lister les domaines avec:

Sub AllDomainsList()
Dim nSpace As Object, Domain As Object
Dim Domains As String
Set nSpace = GetObject("WinNT:")
For Each Domain In nSpace
If Len(Domains) Then Domains = Domains & vbLf
Domains = Domains & Domain.Name
Next
MsgBox Domains, 64
End Sub

Ensuite, tu listes les utilisateurs dans le domaine qui t'intéresse avec:

Sub Listing()
Const Domain1 = "Ici le nom du domaine à explorer"
Application.ScreenUpdating = False
Workbooks.Add
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range("A1") = "LOGIN"
Range("B1") = "USER"
Range("C1") = "COMPUTER DESCRIPTION"
Range("A1:C1").Font.Bold = True
Call AllUsersList(Domain1)
Dim i%: i = 2
Do While Cells(i, 1) <> ""
Call UserInfos(Domain1, Cells(i, 1), i)
i = i + 1
Loop
Cells.Columns.AutoFit
End Sub

Sub AllUsersList(sDomain$)
Dim Computer As Object, User As Object
Dim i%: i = 1
Set Computer = GetObject("WinNT://" & sDomain)
Computer.Filter = Array("User")
For Each User In Computer
i = i + 1
Cells(i, 1) = User.Name
Next
Set Computer = Nothing
End Sub

Sub UserInfos(sDomain$, sUser$, ByVal i%)
With GetObject("WinNT://" & sDomain & "/" & sUser & ",user")
Cells(i, 2) = .FullName
Cells(i, 3) = .Description
End With
End Sub

Tu peux utiliser la liste créée pour faire la boucle en excluant
éventuellement les utilisateurs que tu ne veux pas traiter (s'ils ne sont
pas connectés, par exemple).

Pour avoir la liste des machines connectées sur le domaine, tu peux
utiliser:

Sub AllComputersList(sDomain)
Workbooks.Add
Dim Domain As Object, Computer As Object
Dim i%
Set Domain = GetObject("WinNT://" & sDomain)
Domain.Filter = Array("Computer")
For Each Computer In Domain
i = i + 1
Cells(i, 1) = Computer.Name
Next
Set Domain = Nothing
End Sub

Pour te simplifier la vie, tu peux adapter le script vbs en VBA; tu auras
tout en un.

MP

"JohnFuss" a écrit dans le message de news:
dptthj$rmc$
Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il
un

moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName
de

tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" a écrit dans le message de
news:
Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" &
"UserName"

Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur
demander

de
modifier à la main leur utilisateur Office. Mais peut-être un
vbscript

ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro
me

parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias
"GetTempPathA"

(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Merci bcp,

je vais me pencher la-dessus c'est très intéressant.

John

"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de
news:OsfLZMWFGHA.2444@TK2MSFTNGP11.phx.gbl...

Bonsoir John;
1 - Si c'est sur sa propre machine, il suffit d'exécuter le script vbs en
local (dans le script, "." indique l'ordinateur local).
Si c'est sur la machine d'un autre, cela n'a pas d'intérêt car il n'aura
même pas accès à Office si le raccourci de lancement n'est pas placé dans
le

groupe AllUsers.
2 - Comme indiqué précédemment, "." indique l'ordinateur local; si tu as
la

liste des ordinateurs, il suffit de faire une boucle sur le nom de la
macine

en lieu et place de "."

Si tu as les droits nécessaires, tu peux faire tout ça de ton poste en VBA
dans un classeur Excel.
Commence par lister les domaines avec:

Sub AllDomainsList()
Dim nSpace As Object, Domain As Object
Dim Domains As String
Set nSpace = GetObject("WinNT:")
For Each Domain In nSpace
If Len(Domains) Then Domains = Domains & vbLf
Domains = Domains & Domain.Name
Next
MsgBox Domains, 64
End Sub

Ensuite, tu listes les utilisateurs dans le domaine qui t'intéresse avec:

Sub Listing()
Const Domain1 = "Ici le nom du domaine à explorer"
Application.ScreenUpdating = False
Workbooks.Add
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range("A1") = "LOGIN"
Range("B1") = "USER"
Range("C1") = "COMPUTER DESCRIPTION"
Range("A1:C1").Font.Bold = True
Call AllUsersList(Domain1)
Dim i%: i = 2
Do While Cells(i, 1) <> ""
Call UserInfos(Domain1, Cells(i, 1), i)
i = i + 1
Loop
Cells.Columns.AutoFit
End Sub

Sub AllUsersList(sDomain$)
Dim Computer As Object, User As Object
Dim i%: i = 1
Set Computer = GetObject("WinNT://" & sDomain)
Computer.Filter = Array("User")
For Each User In Computer
i = i + 1
Cells(i, 1) = User.Name
Next
Set Computer = Nothing
End Sub

Sub UserInfos(sDomain$, sUser$, ByVal i%)
With GetObject("WinNT://" & sDomain & "/" & sUser & ",user")
Cells(i, 2) = .FullName
Cells(i, 3) = .Description
End With
End Sub

Tu peux utiliser la liste créée pour faire la boucle en excluant
éventuellement les utilisateurs que tu ne veux pas traiter (s'ils ne sont
pas connectés, par exemple).

Pour avoir la liste des machines connectées sur le domaine, tu peux
utiliser:

Sub AllComputersList(sDomain)
Workbooks.Add
Dim Domain As Object, Computer As Object
Dim i%
Set Domain = GetObject("WinNT://" & sDomain)
Domain.Filter = Array("Computer")
For Each Computer In Domain
i = i + 1
Cells(i, 1) = Computer.Name
Next
Set Domain = Nothing
End Sub

Pour te simplifier la vie, tu peux adapter le script vbs en VBA; tu auras
tout en un.

MP

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dptthj$rmc$1@s1.news.oleane.net...

Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il
un

moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName
de

tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de
news:OoGw9j9EGHA.2064@TK2MSFTNGP09.phx.gbl...

Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" &
"UserName"

Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:\" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" <john@fuss.fr> a écrit dans le message de news:
dpjf46$t08$1@s1.news.oleane.net...

Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de

l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur
demander

de

modifier à la main leur utilisateur Office. Mais peut-être un
vbscript

ferai

l'affaire par contre je n'y connais rien. La livraixson de ma macro
me

parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias
"GetTempPathA"

(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

Vous avez filtré cet utilisateur ! Consultez son message

Merci bcp,

je vais me pencher la-dessus c'est très intéressant.

John

"Michel Pierron" a écrit dans le message de
news:

Bonsoir John;
1 - Si c'est sur sa propre machine, il suffit d'exécuter le script vbs en
local (dans le script, "." indique l'ordinateur local).
Si c'est sur la machine d'un autre, cela n'a pas d'intérêt car il n'aura
même pas accès à Office si le raccourci de lancement n'est pas placé dans
le

groupe AllUsers.
2 - Comme indiqué précédemment, "." indique l'ordinateur local; si tu as
la

liste des ordinateurs, il suffit de faire une boucle sur le nom de la
macine

en lieu et place de "."

Si tu as les droits nécessaires, tu peux faire tout ça de ton poste en VBA
dans un classeur Excel.
Commence par lister les domaines avec:

Sub AllDomainsList()
Dim nSpace As Object, Domain As Object
Dim Domains As String
Set nSpace = GetObject("WinNT:")
For Each Domain In nSpace
If Len(Domains) Then Domains = Domains & vbLf
Domains = Domains & Domain.Name
Next
MsgBox Domains, 64
End Sub

Ensuite, tu listes les utilisateurs dans le domaine qui t'intéresse avec:

Sub Listing()
Const Domain1 = "Ici le nom du domaine à explorer"
Application.ScreenUpdating = False
Workbooks.Add
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range("A1") = "LOGIN"
Range("B1") = "USER"
Range("C1") = "COMPUTER DESCRIPTION"
Range("A1:C1").Font.Bold = True
Call AllUsersList(Domain1)
Dim i%: i = 2
Do While Cells(i, 1) <> ""
Call UserInfos(Domain1, Cells(i, 1), i)
i = i + 1
Loop
Cells.Columns.AutoFit
End Sub

Sub AllUsersList(sDomain$)
Dim Computer As Object, User As Object
Dim i%: i = 1
Set Computer = GetObject("WinNT://" & sDomain)
Computer.Filter = Array("User")
For Each User In Computer
i = i + 1
Cells(i, 1) = User.Name
Next
Set Computer = Nothing
End Sub

Sub UserInfos(sDomain$, sUser$, ByVal i%)
With GetObject("WinNT://" & sDomain & "/" & sUser & ",user")
Cells(i, 2) = .FullName
Cells(i, 3) = .Description
End With
End Sub

Tu peux utiliser la liste créée pour faire la boucle en excluant
éventuellement les utilisateurs que tu ne veux pas traiter (s'ils ne sont
pas connectés, par exemple).

Pour avoir la liste des machines connectées sur le domaine, tu peux
utiliser:

Sub AllComputersList(sDomain)
Workbooks.Add
Dim Domain As Object, Computer As Object
Dim i%
Set Domain = GetObject("WinNT://" & sDomain)
Domain.Filter = Array("Computer")
For Each Computer In Domain
i = i + 1
Cells(i, 1) = Computer.Name
Next
Set Domain = Nothing
End Sub

Pour te simplifier la vie, tu peux adapter le script vbs en VBA; tu auras
tout en un.

MP

"JohnFuss" a écrit dans le message de news:
dptthj$rmc$
Bonjour Michel,

quelques interrogations supplémentaires :

*Si je me connect avec un nouvel utilisateur sur une machine, y'a t'il
un

moyen pour que son nom d'utilisateur Office soit identique à son nom
d'utilisateur Windows ?
*Est-ce que ton vbs est modifiable pour le voir modifier le OfficeName
de

tous les utilisateurs connus de Windows ?

Merci d'avance.

"Michel Pierron" a écrit dans le message de
news:
Bonsoir John;
A enregistrer en .vbs

Dim xlVersion, LogName, UserOffice, sPath

Function RegRead(ByVal RegPath)
On Error Resume Next
RegRead = CreateObject("wscript.shell").RegRead(RegPath)
If Err Then Err.Clear: RegRead = Null
End Function

If IsNull(RegRead("HKCRExcel.Application")) Then
MsgBox "Application Excel non installée sur cette machine !", 48
WScript.Quit
End If
xlVersion = Mid(RegRead("HKCRExcel.ApplicationCurVer"), 19)
sPath = "SoftwareMicrosoftOffice"
sPath = sPath & xlVersion & ".0" & "CommonUserInfo"
LogName = CreateObject("WScript.Network").UserName
UserOffice = KeyValue(sPath, "UserName", ".")
If UserOffice = "" Then
MsgBox "Erreur de lecture clé Office UserName !", 48
WScript.Quit
End If
Dim Msg
Msg = "Login user: " & Chr(9) & LogName & Chr(10)
Msg = Msg & "Office user: " & Chr(9) & UserOffice
If LogName <> UserOffice Then
Msg = Msg & Chr(10) & Chr(10) & "Voulez-vous utiliser "
Msg = Msg & LogName & Chr(10) & " comme nom d'utilisateur office ?"
If MsgBox(Msg, 4 + 32 + 256) = vbYes Then
' Suppression cle actuelle
CreateObject("WScript.Shell").RegDelete "HKCU" & sPath & "" &
"UserName"

Call MajOfficeUser(LogName, sPath, "UserName", ".")
End If
Else
MsgBox Msg, 64
End If

' Lecture cle Office UserName (HKCU = &H80000001)
Function KeyValue(ByVal sPath, ByVal sKey, sComputer)
Dim Obj, i, Data
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

If Obj.GetBinaryValue(&H80000001, sPath, sKey, Data)=0 Then
For i = LBound(Data) To UBound(Data)
If Data(i) > 0 Then KeyValue = KeyValue & Chr(Data(i))
Next
End If
Set Obj = Nothing
End Function

' Ecriture cle Office UserName = Login UserName
Sub MajOfficeUser(ByVal LogName, ByVal sPath, ByVal sKey, sComputer)
Dim Obj, Data(), i, k
ReDim Data(Len(LogName) * 2 + 1)
For i = 1 To Len(LogName)
Data(k) = Asc(Mid(LogName, i, 1))
k = k + 1: Data(k) = 0: k = k + 1
Next
Data(k) = 0: k = k + 1: Data(k) = 0
Set Obj = GetObject("winmgmts:" & sComputer &
"rootdefault:StdRegProv")

Obj.SetBinaryValue &H80000001, sPath, sKey, Data
Set Obj = Nothing
MsgBox "Mise à jour effectuée !", 64
End Sub

MP

"JohnFuss" a écrit dans le message de news:
dpjf46$t08$
Bonjour,

tous les PCs de ma société sont installés depuis une image Ghost
générique,

du coup tous les postes ont le même nom d'utilisateur (le nom de la
boite)

dans les applications Office. Dans une macro déployée dans 10% des
postes

de
l'entreprise je force l'utilisateur Office pour y mettre le nom du
l'utilisateur Windows.

Je comptais envoyer un mail à tous les utilisateurs pour leur
demander

de
modifier à la main leur utilisateur Office. Mais peut-être un
vbscript

ferai
l'affaire par contre je n'y connais rien. La livraixson de ma macro
me

parait un peu 'lourd' pour les utilisateurs.

Voici ce que j'utilise en ce moment dans Excel :

Application.UserName = GetSystemInfo(UserName)

avec
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA"

(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias
"GetTempPathA"

(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Enum SystemInfos
UserName = 0
ComputerName = 1
TempPath = 2
End Enum

Public Function GetSystemInfo(InfoType As SystemInfos) As String
Dim Buffer As String

GetSystemInfo = String(255, Chr$(0))
Select Case InfoType
Case UserName
GetUserName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
Case ComputerName
GetComputerName GetSystemInfo, Len(GetSystemInfo)
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
Case TempPath
Buffer = Space(255)
GetTempPath Len(GetSystemInfo), GetSystemInfo
GetSystemInfo = Left$(GetSystemInfo,
InStr(GetSystemInfo,

Chr$(0)) - 1)
End Select
End Function

Merci d'avance.

John

[Léger HS] Script VB ?

9 réponses

Veuillez sélectionner un problème