1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
| Const xlContinuous = 1
Const xlThin = 2
Const xlAutomatic = -4105
Const xlCenter = -4108
Set objShell = CreateObject("wscript.shell")
strExcelPath = objShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\excel.exe\")
If strExcelPath = "" Then
MsgBox "Unable to export. Excel does not appear to be installed.", vbExclamation, "PC Management Utility"
End If
Dim objXL
Set objXL = CreateObject("Excel.Application")
objXL.Visible = False
Set objWorkBook = objXL.WorkBooks.Add
objXL.DisplayAlerts = False
'For i = 1 to 2
' objWorkbook.Worksheets(2).Delete
'Next
objXL.DisplayAlerts = True
Set objWorksheet = objWorkbook.Worksheets(1)
objWorksheet.Name = "Process Details"
objWorksheet.Tab.ColorIndex = 3
'objWorkSheet.Cells(1, 1) = "Processes on " & strPC
'objWorkSheet.Cells(3, 1) = "Running Processes: " & intProcesses
'intStartRow = 6
' objWorkSheet.Cells(5, 1) = "Process"
' objWorkSheet.Cells(5, 2) = "Process ID"
' objWorkSheet.Cells(5, 3) = "User Name"
' objWorkSheet.Cells(5, 4) = "Mem Usage (KB)"
objWorkSheet.Cells(1,4).Value = Titre
objXL.Visible = True
'objXL.Sheets("Feuil1").Name = "Processus"
'objXL.ActiveSheet.Tab.ColorIndex = 3
'objXL.Sheets("Feuil2").Name = "Services"
'objXL.ActiveSheet.Tab.ColorIndex = 3
'objXL.Sheets("Feuil3").Name = "Startup"
'objXL.ActiveSheet.Tab.ColorIndex = 3
'Récupération de la feuille s'appellant maFeuille
nl=2
nc=0
objXL.Selection.Columns.AutoFit
objXL.Rows("1:150").Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 12
objXL.Cells(2, 1).Value = "Nom du Processus"
objXL.Cells(2, 1).Font.Bold = TRUE
objXL.Cells(2, 1).Interior.ColorIndex = 43
objXL.Cells(2, 1).Font.ColorIndex = 2
objXL.Cells(2,1).Select
'objXL.Selection.Columns.AutoFit
'*************************************************
objXL.Cells(2, 2).Value = "Ligne de Commande"
objXL.Cells(2, 2).Font.Bold = TRUE
objXL.Cells(2, 2).Interior.ColorIndex = 43
objXL.Cells(2, 2).Font.ColorIndex = 2
objXL.Cells(2,2).Select
'objXL.Selection.Columns.AutoFit
'*************************************************
'objXL.Cells(2, 3).Value = "Ligne de Commande"
'objXL.Cells(2, 3).Font.Bold = TRUE
'objXL.Cells(2, 3).Interior.ColorIndex = 43
'objXL.Cells(2, 3).Font.ColorIndex = 2
'objXL.Cells(2,3).Select
'objXL.Selection.Columns.AutoFit
'************************************************
Dim Computer : Computer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& Computer & "\root\cimv2")
Set ColProcess = objWMIService.ExecQuery ("Select * from Win32_Process")
x=2
nc=0
nproc=0
for each Process in ColProcess
x = x + 1
objXL.Cells(x, 1) = Process.Name
objXL.Cells(x, 2) = Process.CommandLine
Next
objXL.Columns("A:A").EntireColumn.AutoFit
objXL.Columns("B:B").EntireColumn.AutoFit
Call Services()
Call Startup()
Call SaveWorkbook()
'objXL.Sheets("Feuil1").Name = "Processus"
' objXL.ActiveSheet.Tab.ColorIndex = 3
' objXL.Sheets("Feuil2").Name = "Services"
'objXL.Sheets("Services Details").ColorIndex = 3
'objXL.Sheets("Feuil3").Name = "Startup"
'objXL.Sheets("Startup").Tab.ColorIndex = 3
' -------------------------------------
Function Titre
Set network = Wscript.CreateObject("WScript.Network")
computer=Ucase(network.ComputerName)
RootTitle=" Processus_" & computer
Titre=rootTitle & " " & Date & " " & Time
End Function
' -------------------------------------
Sub Services()
' Create a new and blank spreadsheet:
'Set sheet = objXL.ActiveWorkbook.Sheets("Services")
'Set objWorksheet = objWorkbook.Worksheets(2)
Set sheet = objWorkbook.Worksheets(2)
sheet.Name = "Services Details"
' Format the cell A1 and add the text: Service
sheet.Cells(1, 1).Value = "Nom du Service"
sheet.Cells(1, 1).Font.Bold = TRUE
sheet.Cells(1, 1).Interior.ColorIndex = 43
sheet.Cells(1, 1).Font.ColorIndex = 2
' Format the cell A2 and add the text: Status
sheet.Cells(1, 2).Value = "Etat du service"
sheet.Cells(1, 2).Font.Bold = TRUE
sheet.Cells(1, 2).Interior.ColorIndex = 43
sheet.Cells(1, 2).Font.ColorIndex = 2
'*************************************************
' Format the cell A3 and add the text: Chemin Executable
sheet.Cells(1, 3).Value = "Chemin Executable"
sheet.Cells(1, 3).Font.Bold = TRUE
sheet.Cells(1, 3).Interior.ColorIndex = 43
sheet.Cells(1, 3).Font.ColorIndex = 2
'*************************************************
' Format the cell A4 and add the text: Description
sheet.Cells(1, 4).Value = "Description du service"
sheet.Cells(1, 4).Font.Bold = TRUE
sheet.Cells(1, 4).Interior.ColorIndex = 43
sheet.Cells(1, 4).Font.ColorIndex = 2
' Find the Windows services on this computer
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServices = objWMIService.ExecQuery("Select * From Win32_Service")
' Write each service to Excel, starting in A2
x = 1
For Each objService in colServices
x = x + 1
sheet.Cells(x, 1) = objService.Name
sheet.Cells(x, 2) = objService.State
sheet.Cells(x, 3) = objService.PathName
sheet.Cells(x, 4) = objService.Description
Etat = objService.Started
If Etat Then
Cellule x,2,"Démarré"
ELSE
Cellule X,2,"Arrêté"
sheet.Cells(x, 2).Font.ColorIndex = 3
sheet.Cells(x, 3).Font.ColorIndex = 3
sheet.Cells(x, 4).Font.ColorIndex = 3
end if
Next
sheet.Columns("A:A").EntireColumn.AutoFit
sheet.Columns("B:B").EntireColumn.AutoFit
sheet.Columns("C:C").EntireColumn.AutoFit
sheet.Columns("D:D").EntireColumn.AutoFit
End Sub
'--------------------------------------------------------------------
Sub Cellule(X,NC,chaine)
Set sheet = objXL.ActiveWorkbook.Sheets(2)
sheet.Cells(X,NC).Value = Chaine
End Sub
'--------------------------------------------------------------------
'Fonction pour déterminer le répertoire en cours
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\"))
End Function
'*********************************************************************
Sub SaveWorkbook()
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Set network = Wscript.CreateObject("WScript.Network")
computer=Ucase(network.ComputerName)
Dim xlVer
NomFichier = Titre
NomFichier = Replace(NomFichier,"/","_")
NomFichier = Replace(NomFichier,":","-")
MsgBox NomFichier
' Détermine la version d'Excel (12.0 = 2007)
xlVer = Split(objXL.Version,".")(0)
'MsgBox xlVer
If xlVer >= "12" Then
ObjXL.ActiveWorkbook.SaveAs fso.GetAbsolutePathName(".") & "\" & NomFichier & ".xlsx"
ObjXL.DisplayAlerts = True
' 56 = Excel 97-2003
' Voir la page http://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.xlfileformat.aspx
Else
ObjXL.ActiveWorkbook.SaveAs fso.GetAbsolutePathName(".") & "\" & NomFichier & ".xls",56
ObjXL.DisplayAlerts = True
End If
End Sub
'*********************************************************************
Sub Startup()
On Error Resume Next
Computer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colStartupCommands = objWMIService.ExecQuery ("Select * from Win32_StartupCommand")
Set objWorkSheet = objWorkbook.Worksheets(3)
objWorkSheet.Name = "Startup Details"
intStartRow = 6
objWorkSheet.Cells(1, 1) = "Startup Items on " & Titre
'objWorkSheet.Cells(3, 1) = "Total: " & intStartup & " Items"
objWorkSheet.Cells(5, 1) = "Startup Item"
objWorkSheet.Cells(5, 2) = "User"
objWorkSheet.Cells(5, 3) = "Command"
objWorkSheet.Cells(5, 4) = "Startup Location"
For Each objStartupCommand in colStartupCommands
strStartupName = Trim(objStartupCommand.Name)
strStartupUser = objStartupCommand.User
strStartupLocation = objStartupCommand.Location
strStartupCommand = objStartupCommand.Command
objWorkSheet.Cells(intStartRow, 1) = strStartupName
objWorkSheet.Cells(intStartRow, 2) = strStartupUser
objWorkSheet.Cells(intStartRow, 3) = strStartupLocation
objWorkSheet.Cells(intStartRow, 4) = strStartupCommand
intStartRow = intStartRow + 1
Next
objWorkSheet.Columns("A:A").EntireColumn.AutoFit
objWorkSheet.Columns("B:B").EntireColumn.AutoFit
objWorkSheet.Columns("C:C").EntireColumn.AutoFit
objWorkSheet.Columns("D:D").EntireColumn.AutoFit
End Sub |
Partager