Bonjour,

J'ai ce script qui liste les logiciels installés dans un fichier txt (encore une fois, mais les résultats de ce script sont plus complets). Mais il affiche 2 message boxes au début et à la fin de son exécution.

J'aimerais éliminer ces deux message boxes pour qu'il s'exécute sans rien afficher, et que le nom du fichier txt soit : logiciels.txt. La partie à changer est dans les 30 premières lignes. Merci de votre aide.

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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Option Explicit  
 
 Dim sTitle  
 sTitle = "InstalledPrograms.vbs by Bill James"  
 Dim StrComputer  
 strComputer = InputBox("Enter I.P. or name of computer to check for " & _  
 "installed software (leave blank to check " & _  
 "local system)." & vbcrlf & vbcrlf & "Remote " & _  
 "checking only from NT type OS to NT type OS " & _  
 "with same Admin level UID & PW", sTitle)  
 If IsEmpty(strComputer) Then WScript.Quit  
 strComputer = Trim(strComputer)  
 If strComputer = "" Then strComputer = "."  
 
 'Wscript.Echo GetAddRemove(strComputer)  
 
 Dim sCompName : sCompName = GetProbedID(StrComputer)  
 
 Dim sFileName  
 sFileName = sCompName & "_" & GetDTFileName() & "_Software.txt"  
 
 Dim s : s = GetAddRemove(strComputer)  
 
 If WriteFile(s, sFileName) Then  
 'optional prompt for display  
 If MsgBox("Finished processing.  Results saved to " & sFileName & _  
 vbcrlf & vbcrlf & "Do you want to view the results now?", _  
 4 + 32, sTitle) = 6 Then  
 WScript.CreateObject("WScript.Shell").Run sFileName, 9  
 End If  
 End If  
 
 Function GetAddRemove(sComp)  
 'Function credit to Torgeir Bakken  
 Dim cnt, oReg, sBaseKey, iRC, aSubKeys  
 Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE  
 Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _  
 sComp & "/root/default:StdRegProv")  
 sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"  
 iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)  
 
 Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay  
 
 For Each sKey In aSubKeys  
 iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)  
 If iRC <> 0 Then  
 oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue  
 End If  
 If sValue <> "" Then  
 iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _  
 "DisplayVersion", sVersion)  
 If sVersion <> "" Then  
 sValue = sValue & vbTab & "Ver: " & sVersion  
 Else  
 sValue = sValue & vbTab   
 End If  
 iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _  
 "InstallDate", sDateValue)  
 If sDateValue <> "" Then  
 sYr =  Left(sDateValue, 4)  
 sMth = Mid(sDateValue, 5, 2)  
 sDay = Right(sDateValue, 2)  
 'some Registry entries have improper date format  
 On Error Resume Next   
 sDateValue = DateSerial(sYr, sMth, sDay)  
 On Error GoTo 0  
 If sdateValue <> "" Then  
 sValue = sValue & vbTab & "Installed: " & sDateValue  
 End If  
 End If  
 sTmp = sTmp & sValue & vbcrlf  
 cnt = cnt + 1  
 End If  
 Next  
 sTmp = BubbleSort(sTmp)  
 GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _  
 " - " & Now() & vbcrlf & vbcrlf & sTmp   
 End Function  
 
 Function BubbleSort(sTmp)  
 'cheapo bubble sort  
 Dim aTmp, i, j, temp  
 aTmp = Split(sTmp, vbcrlf)    
 For i = UBound(aTmp) - 1 To 0 Step -1  
 For j = 0 to i - 1  
 If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then  
 temp = aTmp(j + 1)  
 aTmp(j + 1) = aTmp(j)  
 aTmp(j) = temp  
 End if  
 Next  
 Next  
 BubbleSort = Join(aTmp, vbcrlf)  
 End Function  
 
 Function GetProbedID(sComp)  
 Dim objWMIService, colItems, objItem  
 Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")  
 Set colItems = objWMIService.ExecQuery("Select SystemName from " & _  
 "Win32_NetworkAdapter",,48)  
 For Each objItem in colItems  
 GetProbedID = objItem.SystemName  
 Next  
 End Function  
 
 Function GetDTFileName()  
 dim sNow, sMth, sDay, sYr, sHr, sMin, sSec  
 sNow = Now  
 sMth = Right("0" & Month(sNow), 2)  
 sDay = Right("0" & Day(sNow), 2)  
 sYr = Right("00" & Year(sNow), 4)  
 sHr = Right("0" & Hour(sNow), 2)  
 sMin = Right("0" & Minute(sNow), 2)  
 sSec = Right("0" & Second(sNow), 2)  
 GetDTFileName = sMth & sDay & sYr & "_" & sHr & sMin & sSec  
 End Function  
 
 Function WriteFile(sData, sFileName)  
 Dim fso, OutFile, bWrite  
 bWrite = True  
 Set fso = CreateObject("Scripting.FileSystemObject")  
 On Error Resume Next  
 Set OutFile = fso.OpenTextFile(sFileName, 2, True)  
 'Possibly need a prompt to close the file and one recursion attempt.  
 If Err = 70 Then  
 Wscript.Echo "Could not write to file " & sFileName & ", results " & _  
 "not saved." & vbcrlf & vbcrlf & "This is probably " & _  
 "because the file is already open."  
 bWrite = False  
 ElseIf Err Then  
 WScript.Echo err & vbcrlf & err.description  
 bWrite = False  
 End If  
 On Error GoTo 0  
 If bWrite Then  
 OutFile.WriteLine(sData)  
 OutFile.Close  
 End If  
 Set fso = Nothing  
 Set OutFile = Nothing  
 WriteFile = bWrite  
 End Function