Bon je comprend pas trop pourquoi je n'arrive pas à inscrire à la suite les infos suivant ce script...

Dans son état actuel chaque fois que le script roule sur un PC l'information est bien inscrite mais efface la précédente...

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
strComputer = "."
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'--------------------------------------------------------------------------------
Dim xlApp
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
If Err.Number = 0 Then
'If Err.Number <> 0 Then
Err.Clear
'MsgBox "There"
xlApp.Close
'--------------------------------------------------------------------------------
Dim objXL
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objXL = WScript.CreateObject("Excel.Application")
objXL.Workbooks.Add
 
objXL.Cells(1, 1).Value = "Nom"
objXL.Cells(1, 2).Value = "OS+SP"
objXL.Cells(1, 3).Value = "Version"
objXL.Cells(1, 4).Value = "# Série"
objXL.Cells(1, 5).Value = "Fabriquant"
objXL.Cells(1, 6).Value = "Modèle"
objXL.Cells(1, 7).Value = "Mémoire"
objXL.Cells(1, 8).Value = "Installé le"
objXL.Cells(1, 9).Value = "Version Office"
objXL.Cells(1, 10).Value = "Date Inventaire"
 
objXL.Columns(1).ColumnWidth = 28
objXL.Columns(2).ColumnWidth = 65
objXL.Columns(3).ColumnWidth = 20
objXL.Columns(4).ColumnWidth = 15
objXL.Columns(5).ColumnWidth = 20
objXL.Columns(6).ColumnWidth = 20
objXL.Columns(7).ColumnWidth = 20
objXL.Columns(8).ColumnWidth = 20
objXL.Columns(9).ColumnWidth = 20
 
objXL.Range("A1:J1").Select
objXL.Selection.Font.ColorIndex = 41
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 13 
objXL.Selection.Interior.ColorIndex = 46 
objXL.Selection.Interior.Pattern = 1      'xlSolid 
'------------------------------------------------------------------------------------
Set dtmInstallDate = CreateObject( _ 
  "WbemScripting.SWbemDateTime")
 
Function getmydat(wmitime)
  dtmInstallDate.Value = wmitime
  getmydat = dtmInstallDate.GetVarDate
End function
 
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colSettings 
i = i + 1 
objXL.Cells(i+2,1).Value=UCase(WshNetwork.ComputerName)
objXL.Cells(i+2,2).value=objOperatingSystem.Caption & " - Service Pack  " & objOperatingSystem.ServicePackMajorVersion
objXL.Cells(i+2,3).value=objOperatingSystem.Version
objXL.Cells(i+2,4).value=objOperatingSystem.SerialNumber
objXL.Cells(i+2,8).value=getmydat (objOperatingSystem.InstallDate)
Next
'------------------------------------------------------------------------------------------
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings 
 
		objXL.Cells(i+2,5).value=objComputer.Manufacturer
		objXL.Cells(i+2,6).value=objComputer.Model
		objXL.Cells(i+2,7).value=objComputer.TotalPhysicalMemory
Next
'-------------------------------------------------------------------------------------------------
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery ("Select * from Win32_Product Where Caption Like '%Microsoft Office%'")
For Each objItem In colItems
		If Left(objItem.Version, 2) = "14" Then
 
        objXL.Cells(i+2,9).value="Office 2010"
 
	ElseIf Left(objItem.Version, 2) = "12" Then
		objXL.Cells(i+2,9).value="Office 2007"
	ElseIf Left(objItem.Version, 2) = "11" Then
		objXL.Cells(i+2,9).value="Office 2003"
	ElseIf Left(objItem.Version, 2) = "10" Then
		objXL.Cells(i+2,9).value="Office XP"
	Else
		objXL.Cells(i+2,9).value="Autre"
End If
   Next
objXL.Cells(i+2,10).value=Date
 
'-----------------------------------------------------------------------------------------------
objXL.Visible = False
objXL.Application.DisplayAlerts = False
objXL.ActiveWorkbook.SaveAs "\\127.0.0.1\IVentory\PC.xls"
objXL.ActiveWorkbook.Close
objXL.Quit
Set objXL = Nothing
 
Else
'MsgBox "Not There"
xlApp.Close
'-----------------------------------------------------------------------------------------------------
Dim strDirectory, strFile, strText
strDirectory = "\\127.0.0.1\Iventory"
strFile = "\PCNoExcel.txt"
strText = "PC Withoot Excel"
'---------------------------------------------------------------------------------------------------------
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile(strFile, ForAppending, True)
 objFile.WriteLine(WshNetwork.ComputerName & " - " & Now)
objFile.Close
'-----------------------------------------------------------------------------------------------------
End If
Des idées ??

Merci