' ----------------------------------------------------------
' 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
' JC BELLAMY © 2004
' ----------------------------------------------------------

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 &".xls"
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
'--------------------------------------------------------------------