Chers tous bonjour,
En cherchant sur internet à télécharger un script VBS qui permet de lister les groupes et les comptes sur une machine locale ou distante sur EXCEL, j’ai trouvé ce qui suit.
 
**********************************************
' ----------------------------------------------------------
' Script VBS d'affichage sous EXCEL de la liste des
' des groupes et comptes sur une machine locale ou distante
' Syntaxe:
' accountlist [<ordinateur>]
'  <ordinateur> : nom de machine
'                    si absent : ordinateur local
'
' ----------------------------------------------------------
 
Dim net, computer, args, GUSet, Group, User, GDict, UDict, Members, Groups
 
' Constantes EXCEL
' ----------------
Const xlDiagonalDown       = 5
Const xlDiagonalUp         = 6
Const xlEdgeLeft           = 7
Const xlEdgeTop            = 8
Const xlEdgeBottom         = 9
Const xlEdgeRight          =10
Const xlContinous          = 1
Const xlThin               = 2
Const xlMedium            =&HFFFFEFD6
Const xlThick              = 4
Const xlDouble             =&HFFFFEFE9
Const xlAutomatic          =&HFFFFEFF7
Const xlInsideVertical     = 11
Const xlInsideHorizontal   = 12
Const xlNone               =&HFFFFEFD2
Const xlUnderlineStyleNone =&HFFFFEFD2
Const xlCenter             =&HFFFFEFF4
Const xlBottom             =&HFFFFEFF5
Const xlContext            =&HFFFFEC76
Const xlSolid              = 1
Const msoFalse             = 0
Const msoScaleFromTopLeft  = 0
 
Const xlR1C1               =&HFFFFEFCA
 
' Couleurs EXCEL
' --------------
Black         =  1
Brown         = 53
OliveGreen    = 52
DarkGreen     = 51
DarkGreenBlue = 49
DarkBlue      = 11
Indigo        = 55
Grey80        = 56
 
DarkRed       =  9
Orange        = 46
LightBrown    = 12
Green         = 10
GreenBlue     = 14
Blue          =  5
GrayBlue      = 47
Gray50        = 16
 
Red           =  3
LightOrange   = 45
LimeGreen     = 43
MarineGreen   = 50
WaterGreen    = 42
LightBlue     = 41
Violet        = 13
Gray40        = 48
 
Pink          =  7
Gold          = 44
Yellow        =  6
BrigthGreen   =  4
Turquoise     =  8
SkyBlue       = 33
Plum          = 54
Grey25        = 15
 
SalmonPink    = 38
Brown         = 40
LightYellow   = 36
LightGreen    = 35
LightTurquoise= 34
MediumBlue    = 37
Lavender      = 39
White         =  2
 
Set net   = Wscript.CreateObject("WScript.Network" )
Set fso   = WScript.CreateObject("Scripting.FileSystemObject" )
Set args  = Wscript.Arguments
If args.count=0 Then
 computer=net.ComputerName
Else
 computer=args(0)
 End If
 
Set GDict = WScript.CreateObject("Scripting.Dictionary" )
Set UDict = WScript.CreateObject("Scripting.Dictionary" )
 
Set GUset = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).InstancesOf _
 ("Win32_GroupUser" )
 
for each GU in GUset  
 set Group=GetObject("winmgmts:" & GU.GroupComponent)
 set User=GetObject("winmgmts:" & GU.PartComponent)
 GName=Group.Name
 Uname=User.Name
 If GDict.Exists(GName) Then
  OldList=GDict.Item(GName)
  GDict.Item(GName)=OldList & "," & UName  
 Else
  GDict.Add GName, UName
  End If  
 
 If UDict.Exists(UName) Then
  OldList=UDict.Item(UName)
  UDict.Item(UName)=OldList & "," & GName  
 Else
  UDict.Add UName, GName
  End If  
 next
 
Dim GTabG,GtabU, UTabU, UTabG
GtabG=GDict.Keys  
GtabU=GDict.Items  
UtabU=UDict.Keys  
UtabG=UDict.Items
 
Set oXL = WScript.CreateObject("EXCEL.application" )
oXL.Visible = True
oXL.Workbooks.Add
 
Cellule 1,1,"Liste des  Groupes et Comptes de l'ordinateur " & Computer & " le " & FormatDateTime(now, vbLongDate),true,false,12
 
NL=3
Cellule NL,2,"GROUPE",true,false,10
Cellule NL,3,"COMPTES DU GROUPE",true,false,10
Color NL,2,NL,3,xlMedium,Grey25
IndexCol=1
For i = 0 To GDict.count-1
 Members=Split(GtabU(i),"," )
 nm=Ubound(Members)
 NL=NL+1
 NLdeb=NL
 Cellule NL,2,GtabG(i),true,false,8
 If nm>=0 Then
  For j = 0 To nm
   If j>0 Then NL=NL+1
   Cellule NL,3,Members(j),false,false,8
   Next
  End If
 Color NLdeb,2,NL,3,xlThin,LightTurquoise
 Next
Color 3,2,NL,3,xlMedium,-2
NLMax=NL
 
NL=3
Cellule NL,5,"COMPTE",true,false,10
Cellule NL,6,"APPARTENANCE",true,false,10
Color NL,5,NL,6,xlMedium,Grey25
IndexCol=1
For i = 0 To UDict.count-1
 Groups=Split(UtabG(i),"," )
 ng=Ubound(Groups)
 NL=NL+1
 NLdeb=NL
 Cellule NL,5,UtabU(i),true,false,8
 If ng>=0 Then
  For j = 0 To ng
   If j>0 Then NL=NL+1  
   Cellule NL,6,Groups(j),false,false,8
   Next
  End If
 Color NLdeb,5,NL,6,xlThin,LightTurquoise
 Next
Color 3,5,NL,6,xlMedium,-2
 
If NL>NLmax Then NLMax=NL
 
Cellule NLMax+2,1,"JCB © 2004",false,true,8
oXL.Columns("B:F" ).Select
oXL.Selection.Columns.AutoFit
oXL.Range("A1" ).Select
ExcelFile=getpath() & "Liste des comptes de " & Computer &".xlsx"
If fso.FileExists(ExcelFile) Then fso.DeleteFile ExcelFile, true  
oXL.ActiveWorkbook.SaveAs ExcelFile
oXL.ACtiveWorkbook.Saved = True
Wscript.quit
'--------------------------------------------------------------------
Sub Cellule(NumL,NumC,chaine,casse,italic,size)
oXL.Cells(NumL,NumC).Value = Chaine
If casse or size<>0 Then
 Coords=CellName(NumL,NumC)
 oXL.Range(Coords & ":" & Coords).Select
 If casse   Then oXL.Selection.Font.Bold = True
 If italic  Then oXL.Selection.Font.Italic = True
 If size<>0 Then oXL.Selection.Font.Size = size
 End If
End Sub
'--------------------------------------------------------------------
Function CellName(NumL,NumC)
If NumC<=26 Then
 anumc=chr(64+NumC)
Else
 n1=int(NumC/26)
 n2=NumC-n1*26
 anumc=chr(64+n1) & chr(64+n2)
 End If
CellName=anumc & NumL
End Function
'--------------------------------------------------------------------
Sub Color(NLdeb,NCdeb,NLfin,NCfin,W,col)
Coords1=CellName(NLdeb,NCdeb)
Coords2=CellName(NLfin,NCfin)
oXL.Range(Coords1 & ":" & Coords2).Select
With oXL.Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
 .Weight = W
    .ColorIndex = xlAutomatic
 End With
With oXL.Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = W
    .ColorIndex = xlAutomatic
 End With
With oXL.Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = W
    .ColorIndex = xlAutomatic
 End With
With oXL.Selection.Borders(xlEdgeRight)
 .LineStyle = xlContinuous
    .Weight = W
    .ColorIndex = xlAutomatic
 End With
With oXL.Selection.Interior
 Select Case col
  Case -1  
   If IndexCol=1 Then
    .ColorIndex = LightTurquoise  
   Else
    .ColorIndex = LightYellow
    End If  
  Case -2
  Case else
   .ColorIndex =col
  End Select
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
 End With
IndexCol=3-IndexCol
End Sub
'--------------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\" ))
End Function
'--------------------------------------------------------------------
 
*****************************************************
Ceci dit, le script fonctionne correctement sur Win XP mais pas sur win7.
Etant donné que mon parc machine est sous 7, merci de m’aider à changer le dit Script.
 
Merci d'avance

Ce sujet a été déplacé de la catégorie Linux et OS Alternatifs vers la categorie Windows & Software par O'gure

Ce sujet a été déplacé de la catégorie Windows & Software vers la categorie Programmation par Wolfman