Recuperation Espace disque
Résolu
cs_barada
Messages postés
54
Date d'inscription
vendredi 26 mars 2004
Statut
Membre
Dernière intervention
13 août 2015
-
28 déc. 2006 à 20:19
cs_barada Messages postés 54 Date d'inscription vendredi 26 mars 2004 Statut Membre Dernière intervention 13 août 2015 - 3 janv. 2007 à 18:43
cs_barada Messages postés 54 Date d'inscription vendredi 26 mars 2004 Statut Membre Dernière intervention 13 août 2015 - 3 janv. 2007 à 18:43
7 réponses
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
1 janv. 2007 à 20:56
1 janv. 2007 à 20:56
Bonsoir à tous,
Bonsoir barada,
Pour tester l' exemple ci-dessous, il suffit de créer un fichier "Liste_Servers.txt",
situé dans le même répertoire que le script.
Structure du fichier:
server1 user1 password1
server2 user2 password2
server3 user3 password3
...
Il reste à améliorer la partie Excel, que j'utilise rarement, préférant, pour ma part, une présentation html.
J'ai fait un rafistolage de plusieurs scripts et ai laissé volontairement les constantes et couleurs excels.
'
Initialisation des différentes constantes Visual Basic et Excel
'
' 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 usuelles EXCEL
' --------------
Black = 1
White = 2
Red = 3
BrigthGreen = 4
Blue = 5
Yellow = 6
Pink = 7
Turquoise = 8
DarkRed = 9
Green = 10
DarkBlue = 11
LightBrown = 12
Violet = 13
GreenBlue = 14
Grey25 = 15
Gray50 = 16
SkyBlue = 33
LightTurquoise= 34
LightGreen = 35
LightYellow = 36
LightYellow = 36
SalmonPink = 38
Lavender = 39
Brown = 40
LightBlue = 41
WaterGreen = 42
LimeGreen = 43
Gold = 44
LightOrange = 45
Orange = 46
GrayBlue = 47
Gray40 = 48
DarkGreenBlue = 49
MarineGreen = 50
DarkGreen = 51
OliveGreen = 52
Brown = 53
Plum = 54
Indigo = 55
Grey80 = 56
'
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const HARD_DISK = 3
'
' Structure du fichier InputFile
' Server User Password
'
InputFile=GetPath() & " Liste_Servers.txt "
ExcelFile =GetPath() & "Disques_servers.xls"
'
'--------------------------------------------------------------------
'
If CheckFileExists(InputFile) Then
Dim objExcel
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.ActiveWindow.DisplayGridlines = False
Cellule 2,1,"Contrôle Disks effectué le " & FormatDateTime(Date, vbLongDate) &_
" à " & Replace(FormatDateTime(Time, 4),":","h"),True,False,10
NL = 5
EnTete = Array("Server","Disque local","Taille Totale (Go)",_
"Espace utilisé (Go)","Espace libre (Go)"," % libre ")
For i=0 To UBound(EnTete)
Cellule NL,i+2,Space(2) & EnTete(i) & Space(2),True,False,10
Color NL,i+2,NL,i+2,xlMedium,SkyBlue
Next
NL = NL + 1
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso.OpenTextFile (InputFile, ForReading, True)
Do While f.AtEndOfStream <> True
If f.AtEndOfStream <> True Then
oTab = Split(f.ReadLine," ")
'MsgBox oTab(0) &vbCr& oTab(1) &vbCr& oTab(2)
Call InfoServer(oTab(0),oTab(1),oTab(2))
End If
Loop
f.Close
Set fso = Nothing
Set f = Nothing
Else
MsgBox InputFile,,"le fichier " & InputFile & " n'existe pas"
WScript.Quit
End If
objExcel.Columns("B:G").Select
objExcel.Selection.Columns.AutoFit
objExcel.Range("A1").Select
Call VisuColors
objExcel.ActiveWorkbook.SaveAs ExcelFile, True
objExcel.ACtiveWorkbook.Saved = True
objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
'objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
'objExcel.Quit
Set objExcel = Nothing
MsgBox "Fin du script"
WScript.Quit
'--------------------------------------------------------------------
Function InfoServer(strComputer,strUser,strPassword)
On Error Resume Next
Const WbemAuthenticationLevelPktPrivacy = 6
strNamespace = "root\cimv2"
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer _
(strComputer, strNamespace, strUser, strPassword)
objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
If Err.Number = 0 Then
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
Dim strDiskSize, strDiskUsed
' Conversion de la taille totale en Go : division par 1073741824 (1024x1024x1024)
' Conversion de la taille totale en Mo : division par 1048576 (1024x1024)
strDiskUsed = FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824)
strDiskSize = FormatNumber(objDisk.Size / 1073741824,2)
If strDiskSize <> "" And strDiskUsed <> "" Then
Ligne = Array(Space(2) & strComputer & Space(2),_
objDisk.DeviceID,_
FormatNumber(objDisk.Size / 1073741824,2),_
FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824),_
FormatNumber(objDisk.Freespace / 1073741824,2),_
FormatNumber(objDisk.FreeSpace/objDisk.Size,2) * 100 & " %")
i = ""
For i=0 To UBound(Ligne)
Cellule NL,i+2,Space(2) & Replace(Ligne(i),"'","") & Space(2),True,False,10
Color NL,i+2,NL,i+2,xlMedium,LightOrange
Next
NL = NL + 1
End If
Next
Else
MsgBox ("Erreur sur machine '" & strComputer & "' : code erreur " &_
CStr(Err.Number) & " " & Err.Description),,"Problème d'exécution"
Err.Clear
End If
Set colDisks = Nothing
Set objWMIService = Nothing
Set objWbemLocator = Nothing
End function
'--------------------------------------------------------------------
Sub Cellule(NumL,NumC,chaine,casse,italic,size)
objExcel.Cells(NumL,NumC).Value = Chaine
objExcel.Selection.Font.Bold = True
'If casse Then
If italic Then objExcel.Selection.Font.Italic = True
If size<>0 Then objExcel.Selection.Font.Size = size
End Sub
'--------------------------------------------------------------------
' Création variable nom de la colonne sous la forme A2...L5
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
'MsgBox CellName,,"vérif cellname"
End Function
'--------------------------------------------------------------------
'
Sub Color(NLdeb,NCdeb,NLfin,NCfin,W,col)
Coords1=CellName(NLdeb,NCdeb)
Coords2=CellName(NLfin,NCfin)
objExcel.Range(Coords1 & ":" & Coords2).Select
'objExcel.Selection.Columns.AutoFit
With objExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With objExcel.Selection.Borders(xlEdgeLeft)
.LineStyle =xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Borders(xlEdgeTop)
.LineStyle =xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Borders(xlEdgeBottom)
.LineStyle =xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Borders(xlEdgeRight)
.LineStyle= xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Interior
.ColorIndex= Col
.Pattern = xlSolid
.PatternColorIndex= xlAutomatic
End With
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
'-------------------------------------------------------
' Fonction : Vérification de l'existence du fichier
' contenant server/user/pssw '
Function CheckFileExists(sFileName)
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
If (Fso.FileExists(sFileName)) Then
CheckFileExists = True
Else
CheckFileExists = False
End If
Set Fso = Nothing
End Function
'-------------------------------------------------------
' Correspondance couleurs
'
Function VisuColors
For i = 1 to 56
objExcel.Cells(i+4, 1).Value = i
objExcel.Cells(i+4, 1).Interior.ColorIndex = i
Next
End Function
jean-marc
Bonsoir barada,
Pour tester l' exemple ci-dessous, il suffit de créer un fichier "Liste_Servers.txt",
situé dans le même répertoire que le script.
Structure du fichier:
server1 user1 password1
server2 user2 password2
server3 user3 password3
...
Il reste à améliorer la partie Excel, que j'utilise rarement, préférant, pour ma part, une présentation html.
J'ai fait un rafistolage de plusieurs scripts et ai laissé volontairement les constantes et couleurs excels.
'
Initialisation des différentes constantes Visual Basic et Excel
'
' 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 usuelles EXCEL
' --------------
Black = 1
White = 2
Red = 3
BrigthGreen = 4
Blue = 5
Yellow = 6
Pink = 7
Turquoise = 8
DarkRed = 9
Green = 10
DarkBlue = 11
LightBrown = 12
Violet = 13
GreenBlue = 14
Grey25 = 15
Gray50 = 16
SkyBlue = 33
LightTurquoise= 34
LightGreen = 35
LightYellow = 36
LightYellow = 36
SalmonPink = 38
Lavender = 39
Brown = 40
LightBlue = 41
WaterGreen = 42
LimeGreen = 43
Gold = 44
LightOrange = 45
Orange = 46
GrayBlue = 47
Gray40 = 48
DarkGreenBlue = 49
MarineGreen = 50
DarkGreen = 51
OliveGreen = 52
Brown = 53
Plum = 54
Indigo = 55
Grey80 = 56
'
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const HARD_DISK = 3
'
' Structure du fichier InputFile
' Server User Password
'
InputFile=GetPath() & " Liste_Servers.txt "
ExcelFile =GetPath() & "Disques_servers.xls"
'
'--------------------------------------------------------------------
'
If CheckFileExists(InputFile) Then
Dim objExcel
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.DisplayAlerts = False
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.ActiveWindow.DisplayGridlines = False
Cellule 2,1,"Contrôle Disks effectué le " & FormatDateTime(Date, vbLongDate) &_
" à " & Replace(FormatDateTime(Time, 4),":","h"),True,False,10
NL = 5
EnTete = Array("Server","Disque local","Taille Totale (Go)",_
"Espace utilisé (Go)","Espace libre (Go)"," % libre ")
For i=0 To UBound(EnTete)
Cellule NL,i+2,Space(2) & EnTete(i) & Space(2),True,False,10
Color NL,i+2,NL,i+2,xlMedium,SkyBlue
Next
NL = NL + 1
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso.OpenTextFile (InputFile, ForReading, True)
Do While f.AtEndOfStream <> True
If f.AtEndOfStream <> True Then
oTab = Split(f.ReadLine," ")
'MsgBox oTab(0) &vbCr& oTab(1) &vbCr& oTab(2)
Call InfoServer(oTab(0),oTab(1),oTab(2))
End If
Loop
f.Close
Set fso = Nothing
Set f = Nothing
Else
MsgBox InputFile,,"le fichier " & InputFile & " n'existe pas"
WScript.Quit
End If
objExcel.Columns("B:G").Select
objExcel.Selection.Columns.AutoFit
objExcel.Range("A1").Select
Call VisuColors
objExcel.ActiveWorkbook.SaveAs ExcelFile, True
objExcel.ACtiveWorkbook.Saved = True
objExcel.DisplayAlerts=True 'remet l'alerte
'objExcel.Application.Visible=True 'remet la visibilité
'objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
'objExcel.Quit
Set objExcel = Nothing
MsgBox "Fin du script"
WScript.Quit
'--------------------------------------------------------------------
Function InfoServer(strComputer,strUser,strPassword)
On Error Resume Next
Const WbemAuthenticationLevelPktPrivacy = 6
strNamespace = "root\cimv2"
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer _
(strComputer, strNamespace, strUser, strPassword)
objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
If Err.Number = 0 Then
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
Dim strDiskSize, strDiskUsed
' Conversion de la taille totale en Go : division par 1073741824 (1024x1024x1024)
' Conversion de la taille totale en Mo : division par 1048576 (1024x1024)
strDiskUsed = FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824)
strDiskSize = FormatNumber(objDisk.Size / 1073741824,2)
If strDiskSize <> "" And strDiskUsed <> "" Then
Ligne = Array(Space(2) & strComputer & Space(2),_
objDisk.DeviceID,_
FormatNumber(objDisk.Size / 1073741824,2),_
FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824),_
FormatNumber(objDisk.Freespace / 1073741824,2),_
FormatNumber(objDisk.FreeSpace/objDisk.Size,2) * 100 & " %")
i = ""
For i=0 To UBound(Ligne)
Cellule NL,i+2,Space(2) & Replace(Ligne(i),"'","") & Space(2),True,False,10
Color NL,i+2,NL,i+2,xlMedium,LightOrange
Next
NL = NL + 1
End If
Next
Else
MsgBox ("Erreur sur machine '" & strComputer & "' : code erreur " &_
CStr(Err.Number) & " " & Err.Description),,"Problème d'exécution"
Err.Clear
End If
Set colDisks = Nothing
Set objWMIService = Nothing
Set objWbemLocator = Nothing
End function
'--------------------------------------------------------------------
Sub Cellule(NumL,NumC,chaine,casse,italic,size)
objExcel.Cells(NumL,NumC).Value = Chaine
objExcel.Selection.Font.Bold = True
'If casse Then
If italic Then objExcel.Selection.Font.Italic = True
If size<>0 Then objExcel.Selection.Font.Size = size
End Sub
'--------------------------------------------------------------------
' Création variable nom de la colonne sous la forme A2...L5
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
'MsgBox CellName,,"vérif cellname"
End Function
'--------------------------------------------------------------------
'
Sub Color(NLdeb,NCdeb,NLfin,NCfin,W,col)
Coords1=CellName(NLdeb,NCdeb)
Coords2=CellName(NLfin,NCfin)
objExcel.Range(Coords1 & ":" & Coords2).Select
'objExcel.Selection.Columns.AutoFit
With objExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With objExcel.Selection.Borders(xlEdgeLeft)
.LineStyle =xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Borders(xlEdgeTop)
.LineStyle =xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Borders(xlEdgeBottom)
.LineStyle =xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Borders(xlEdgeRight)
.LineStyle= xlContinuous
.Weight = W
.ColorIndex =xlAutomatic
End With
With objExcel.Selection.Interior
.ColorIndex= Col
.Pattern = xlSolid
.PatternColorIndex= xlAutomatic
End With
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
'-------------------------------------------------------
' Fonction : Vérification de l'existence du fichier
' contenant server/user/pssw '
Function CheckFileExists(sFileName)
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
If (Fso.FileExists(sFileName)) Then
CheckFileExists = True
Else
CheckFileExists = False
End If
Set Fso = Nothing
End Function
'-------------------------------------------------------
' Correspondance couleurs
'
Function VisuColors
For i = 1 to 56
objExcel.Cells(i+4, 1).Value = i
objExcel.Cells(i+4, 1).Interior.ColorIndex = i
Next
End Function
jean-marc
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
3 janv. 2007 à 12:31
3 janv. 2007 à 12:31
Bonjour à tous
Bonjour barada,
pour tester sur ton poste local, tu ne peux pas utiliser l'objet "SWbemLocator".
Ne pas oublier que sur poste local, tu n'as pas besoin de wbem et wmi car fso+network(ou shell) suffit.
Il faut simplement:
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso.OpenTextFile (InputFile, ForReading, True)
Do While f.AtEndOfStream <> True
If f.AtEndOfStream <> True Then
oTab = Split(f.ReadLine," ")
'MsgBox oTab(0) &vbCr& oTab(1) &vbCr& oTab(2)
Call InfoServer(oTab(0))
End If
Loop
.....
Function InfoServer(oTab)
strComputer = ""
strComputer = oTab
'MsgBox strComputer,,"strComputer"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
If Err.Number = 0 Then
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
....
Dans le fichier "liste_servers", tu peux mettre x fois la même ligne.
J'ai testé at home (sans wbem) sur mon poste,
puis au boulot (avec wbem), à partir de mon poste, sur x servers du réseau.
Entre local et server, la définition de "objWMIService" n'est pas la même.
Reste la présentation excel à améliorer et à personnaliser.
jean-marc
Bonjour barada,
pour tester sur ton poste local, tu ne peux pas utiliser l'objet "SWbemLocator".
Ne pas oublier que sur poste local, tu n'as pas besoin de wbem et wmi car fso+network(ou shell) suffit.
Il faut simplement:
Set fso = CreateObject ("Scripting.FileSystemObject")
Set f = fso.OpenTextFile (InputFile, ForReading, True)
Do While f.AtEndOfStream <> True
If f.AtEndOfStream <> True Then
oTab = Split(f.ReadLine," ")
'MsgBox oTab(0) &vbCr& oTab(1) &vbCr& oTab(2)
Call InfoServer(oTab(0))
End If
Loop
.....
Function InfoServer(oTab)
strComputer = ""
strComputer = oTab
'MsgBox strComputer,,"strComputer"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
If Err.Number = 0 Then
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
....
Dans le fichier "liste_servers", tu peux mettre x fois la même ligne.
J'ai testé at home (sans wbem) sur mon poste,
puis au boulot (avec wbem), à partir de mon poste, sur x servers du réseau.
Entre local et server, la définition de "objWMIService" n'est pas la même.
Reste la présentation excel à améliorer et à personnaliser.
jean-marc
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
29 déc. 2006 à 11:23
29 déc. 2006 à 11:23
Bonjour à tous,
Bonjour "barada",
Ne pas oublier de valider le(s) réponse(s) ok sur le topic d'hier !!!
Exemple pour lister les disks d'un server distant:
OXALYS = server
oxalys = pssw
On Error Resume Next
Const WbemAuthenticationLevelPktPrivacy = 6
strCredentials = InputBox _
("Please enter the user name, a blank space, and then the password:", _
"Enter User Credentials", "OXALYS oxalys")
If strCredentials = "" Then
Wscript.Quit
End If
arrCredentials = Split(strCredentials," ")
strUser = arrCredentials(0)
strPassword = arrCredentials(1)
strNamespace = "root\cimv2"
Set objNetwork = CreateObject("Wscript.Network")
strLocalComputer = objNetwork.ComputerName
strComputer = InputBox _
("Please enter the name of the computer you want to connect to:", _
"Enter Computer Name", "OXALYS")
If strComputer = "" Then
Wscript.QUit
End If
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer _
(strComputer, strNamespace, strUser, strPassword)
objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
' =====================================================================
' Insert your code here' Set colItems objWMIService.ExecQuery _
("Select * From Win32_OperatingSystem")
For Each objItem in ColItems
Wscript.Echo strComputer & ": " & objItem.Caption
Next
Const HARD_DISK = 3
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
WScript.Echo objDisk.DeviceID &vbCrLf&_
objDisk.VolumeName &vbCrLf&_
"strDiskUsed: " & FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824) &vbCrLf&_
"strDiskSize: " & FormatNumber(objDisk.Size / 1073741824,2) &vbCrLf&_
"strDiskFree: " & FormatNumber(objDisk.Freespace / 1073741824,2) &vbCrLf&_
"strPercFree: " & FormatNumber(objDisk.FreeSpace/objDisk.Size,2)
Next
' =====================================================================
' End' Set colItems Nothing
Set colDisks = Nothing
Set objWMIService = Nothing
Set objWbemLocator = Nothing
Set objNetwork = Nothing
jean-marc
Bonjour "barada",
Ne pas oublier de valider le(s) réponse(s) ok sur le topic d'hier !!!
Exemple pour lister les disks d'un server distant:
OXALYS = server
oxalys = pssw
On Error Resume Next
Const WbemAuthenticationLevelPktPrivacy = 6
strCredentials = InputBox _
("Please enter the user name, a blank space, and then the password:", _
"Enter User Credentials", "OXALYS oxalys")
If strCredentials = "" Then
Wscript.Quit
End If
arrCredentials = Split(strCredentials," ")
strUser = arrCredentials(0)
strPassword = arrCredentials(1)
strNamespace = "root\cimv2"
Set objNetwork = CreateObject("Wscript.Network")
strLocalComputer = objNetwork.ComputerName
strComputer = InputBox _
("Please enter the name of the computer you want to connect to:", _
"Enter Computer Name", "OXALYS")
If strComputer = "" Then
Wscript.QUit
End If
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer _
(strComputer, strNamespace, strUser, strPassword)
objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
' =====================================================================
' Insert your code here' Set colItems objWMIService.ExecQuery _
("Select * From Win32_OperatingSystem")
For Each objItem in ColItems
Wscript.Echo strComputer & ": " & objItem.Caption
Next
Const HARD_DISK = 3
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
WScript.Echo objDisk.DeviceID &vbCrLf&_
objDisk.VolumeName &vbCrLf&_
"strDiskUsed: " & FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824) &vbCrLf&_
"strDiskSize: " & FormatNumber(objDisk.Size / 1073741824,2) &vbCrLf&_
"strDiskFree: " & FormatNumber(objDisk.Freespace / 1073741824,2) &vbCrLf&_
"strPercFree: " & FormatNumber(objDisk.FreeSpace/objDisk.Size,2)
Next
' =====================================================================
' End' Set colItems Nothing
Set colDisks = Nothing
Set objWMIService = Nothing
Set objWbemLocator = Nothing
Set objNetwork = Nothing
jean-marc
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
29 déc. 2006 à 17:39
29 déc. 2006 à 17:39
Bonjour à tous
j'ai confondu PowerPoint et Excel.
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True 'False
Set objPresentation = objPPT.Presentations.Add
objPresentation.ApplyTemplate("C:\Program Files\Microsoft Office\Templates\1036\Company Meeting.pot")
Set WshShell = WScript.CreateObject("WScript.Shell")
strComputer = WshShell.ExpandEnvironmentStrings("%Computername%")
fichppt=GetPath() & "occupation_disks.ppt"
Const HARD_DISK = 3
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
Set objSlide = objPresentation.Slides.Add(1,2)
Set objShapes = objSlide.Shapes
Set objTitle = objShapes.Item("Rectangle 2")
objTitle.TextFrame.TextRange.Text = vbCrLf & strComputer
strText = vbCrLf & "Disque local :" &vbTab&vbTab
strText = strText & objDisk.DeviceID &vbCrLf&vbCrLf
' Conversion de la taille totale en Go : division par 1073741824 (1024x1024x1024)
' Conversion de la taille totale en Mo : division par 1048576 (1024x1024)
strText = strText & "Taille Totale :" &vbTab&vbTab
strText = strText & FormatNumber(objDisk.Size / 1073741824,2) & " Go" &vbCrLf
strText = strText & "Espace utilisé :" &vbTab&vbTab
strText = strText & FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824) & " Go" &vbCrLf
strText = strText & "Espace libre :" &vbTab&vbTab& FormatNumber(objDisk.Freespace / 1073741824,2) & " Go" &vbCrLf
strText = strText & "Pourcentage libre :" & Space(12) & (FormatNumber(objDisk.FreeSpace/objDisk.Size,2) * 100) & "%"
Set objTitle = objShapes.Item("Rectangle 3")
objTitle.TextFrame.TextRange.Text = strText
Set objTitle = Nothing
Set objShapes = Nothing
Set objSlide = Nothing
Next
Set colDisks = Nothing
Set objWMIService = Nothing
Set WshShell = Nothing
objPresentation.SaveAs(fichppt)
'objPresentation.Close
'objPPT.Quit
Set objPresentation = Nothing
Set objPPT = Nothing
'------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, ""))
End Function
c'est la 1ère fois que j'utilise ppt...et je n'ai pas pu y résister.....
à l'occasion je regarde pour excel, mails il faut plus de précisions:
- old/new doc ?
- un onglet par server ?
- un seul onglet ?
- quelles informations sur les disks;
- combien de colonnes/lignes ?
....
jean-marc
j'ai confondu PowerPoint et Excel.
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True 'False
Set objPresentation = objPPT.Presentations.Add
objPresentation.ApplyTemplate("C:\Program Files\Microsoft Office\Templates\1036\Company Meeting.pot")
Set WshShell = WScript.CreateObject("WScript.Shell")
strComputer = WshShell.ExpandEnvironmentStrings("%Computername%")
fichppt=GetPath() & "occupation_disks.ppt"
Const HARD_DISK = 3
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
Set objSlide = objPresentation.Slides.Add(1,2)
Set objShapes = objSlide.Shapes
Set objTitle = objShapes.Item("Rectangle 2")
objTitle.TextFrame.TextRange.Text = vbCrLf & strComputer
strText = vbCrLf & "Disque local :" &vbTab&vbTab
strText = strText & objDisk.DeviceID &vbCrLf&vbCrLf
' Conversion de la taille totale en Go : division par 1073741824 (1024x1024x1024)
' Conversion de la taille totale en Mo : division par 1048576 (1024x1024)
strText = strText & "Taille Totale :" &vbTab&vbTab
strText = strText & FormatNumber(objDisk.Size / 1073741824,2) & " Go" &vbCrLf
strText = strText & "Espace utilisé :" &vbTab&vbTab
strText = strText & FormatNumber((objDisk.Size - objDisk.FreeSpace) / 1073741824) & " Go" &vbCrLf
strText = strText & "Espace libre :" &vbTab&vbTab& FormatNumber(objDisk.Freespace / 1073741824,2) & " Go" &vbCrLf
strText = strText & "Pourcentage libre :" & Space(12) & (FormatNumber(objDisk.FreeSpace/objDisk.Size,2) * 100) & "%"
Set objTitle = objShapes.Item("Rectangle 3")
objTitle.TextFrame.TextRange.Text = strText
Set objTitle = Nothing
Set objShapes = Nothing
Set objSlide = Nothing
Next
Set colDisks = Nothing
Set objWMIService = Nothing
Set WshShell = Nothing
objPresentation.SaveAs(fichppt)
'objPresentation.Close
'objPPT.Quit
Set objPresentation = Nothing
Set objPPT = Nothing
'------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, ""))
End Function
c'est la 1ère fois que j'utilise ppt...et je n'ai pas pu y résister.....
à l'occasion je regarde pour excel, mails il faut plus de précisions:
- old/new doc ?
- un onglet par server ?
- un seul onglet ?
- quelles informations sur les disks;
- combien de colonnes/lignes ?
....
jean-marc
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_barada
Messages postés
54
Date d'inscription
vendredi 26 mars 2004
Statut
Membre
Dernière intervention
13 août 2015
29 déc. 2006 à 19:13
29 déc. 2006 à 19:13
Bonsoir Jean-Marc
Merci d' avoir répondu à mon post pour résoudre mon pb, soit une feuille et inscription par ligne
Nom serveur, Partion, Espace occupe, espace libre
J' ai validé la question d' hier.
barada
Merci d' avoir répondu à mon post pour résoudre mon pb, soit une feuille et inscription par ligne
Nom serveur, Partion, Espace occupe, espace libre
J' ai validé la question d' hier.
barada
cs_barada
Messages postés
54
Date d'inscription
vendredi 26 mars 2004
Statut
Membre
Dernière intervention
13 août 2015
3 janv. 2007 à 10:09
3 janv. 2007 à 10:09
Bonjour le forum et meilleurs voeux à tous
Jean marc, j' ai testé ton script, le classeur ecel s' ouvre et affiche les colonnes et les noms de champ, mais ne remonte pas les infos. bien entendu j' ai testé sur un poste le mien l' érreur est la suivante "Problème d' exécution, erreur machine paddawan code érreur 424 objet requis.
barada
Jean marc, j' ai testé ton script, le classeur ecel s' ouvre et affiche les colonnes et les noms de champ, mais ne remonte pas les infos. bien entendu j' ai testé sur un poste le mien l' érreur est la suivante "Problème d' exécution, erreur machine paddawan code érreur 424 objet requis.
barada
cs_barada
Messages postés
54
Date d'inscription
vendredi 26 mars 2004
Statut
Membre
Dernière intervention
13 août 2015
3 janv. 2007 à 18:43
3 janv. 2007 à 18:43
Bonsoir Jean-Marc
Merci de m' avoir aidé j' ai modifie le script et sur le local c' est ok,c' est ok aussi pour les serveurs distants. J' ai eu ton méssage, ma modif était déja faite sauf l' amélioration du fichier excel que je n' avais paqs encore fait.
Merci pour tout
barada
Merci de m' avoir aidé j' ai modifie le script et sur le local c' est ok,c' est ok aussi pour les serveurs distants. J' ai eu ton méssage, ma modif était déja faite sauf l' amélioration du fichier excel que je n' avais paqs encore fait.
Merci pour tout
barada
