Recuperation Espace disque [Résolu]

cs_barada 54 Messages postés vendredi 26 mars 2004Date d'inscription 13 août 2015 Dernière intervention - 28 déc. 2006 à 20:19 - Dernière réponse : cs_barada 54 Messages postés vendredi 26 mars 2004Date d'inscription 13 août 2015 Dernière intervention
- 3 janv. 2007 à 18:43
Bonjour le forum
En parcourant la rubrique j' ai trouvé un script qui permet de lister l' espace disponible d' un poste. Ce script m' interesaant pour 3 postes en reseau, j' aurais voulu qu' il scrute chaque poste 'en passant les noms des postes en oparametres) et me renvoie le resultat sur une feuille Excel.
Mercid' avance pour toute aide
barada
Afficher la suite 

7 réponses

Répondre au sujet
cs_JMO 1848 Messages postés jeudi 23 mai 2002Date d'inscription 26 avril 2018 Dernière intervention - 1 janv. 2007 à 20:56
+3
Utile
 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
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de cs_JMO
cs_JMO 1848 Messages postés jeudi 23 mai 2002Date d'inscription 26 avril 2018 Dernière intervention - 3 janv. 2007 à 12:31
+3
Utile
 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
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de cs_JMO
cs_JMO 1848 Messages postés jeudi 23 mai 2002Date d'inscription 26 avril 2018 Dernière intervention - 29 déc. 2006 à 11:23
0
Utile
 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
Commenter la réponse de cs_JMO
cs_JMO 1848 Messages postés jeudi 23 mai 2002Date d'inscription 26 avril 2018 Dernière intervention - 29 déc. 2006 à 17:39
0
Utile
 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
Commenter la réponse de cs_JMO
cs_barada 54 Messages postés vendredi 26 mars 2004Date d'inscription 13 août 2015 Dernière intervention - 29 déc. 2006 à 19:13
0
Utile
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
Commenter la réponse de cs_barada
cs_barada 54 Messages postés vendredi 26 mars 2004Date d'inscription 13 août 2015 Dernière intervention - 3 janv. 2007 à 10:09
0
Utile
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
Commenter la réponse de cs_barada
cs_barada 54 Messages postés vendredi 26 mars 2004Date d'inscription 13 août 2015 Dernière intervention - 3 janv. 2007 à 18:43
0
Utile
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
Commenter la réponse de cs_barada

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.