[Help Plz) Extractions multiples dans un fichier Excel , listing imprimantes

**stanyslassz** · 19/03/2014, 18h58

Bonjour a tous,
and help me please
Je souhaite modifier le script vbs suivant, mais il me manque de sérieuse notion afin d’arrivé a mes fin. Pourtant l’opération n’est pas complexe.
Le script a l’heure actuel permet en entrant le nom du serveur dans la ImputBox de récupérer les imprimantes dispo sur celui-ci ainsi que version des pilotes et ip, puis de les intégrer dans un fichier Excel .Jusque la tout fonctionne bien .
Le problème est que je dois effectuer l’opération pour environ 300 serveurs, et que le script en l’etat actuel me génère donc 300 fichier excel. Burk !

Je souhaiterai supprimer la Imputbox et que le script récupère les noms des serveurs dans un fichier txt
Ou les nom serveurs serais simplement a la ligne
Serv1
Serv3
Serv4
Et qu’il me fasse l’extraction dans un même fichier excel.
Qu’elle et la formule a utilisé a la place du strComputer = InputBox ?
Merci a vous par avance si quelqu’un peut me filer un coup de pouce !

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
On Error Resume Next
 
Dim strComputer, strExcelPath, objExcel, objSheet, k, objGroup
Dim objWMIService, colItems, ErrState, Sheet
 
'Sheet = spreadsheet page, k = row in sheet
Sheet = 1
k = 2
 
strComputer = InputBox ("Please type the print server name to check, " & vbCrLf & _
   "Else enter ALL for all CC print servers", "Server Name","CCPS01")
if strComputer = "" then
  WScript.quit
end if
 
strExcelPath = InputBox ("Please enter the path to save file to: ", "File path", "d:\extractmopier\")
 
strExcelPath = strExcelPath & "Printers_" & strComputer & ".xls"
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Printer",,48)
 
' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If
On Error GoTo 0
 
' Create a new workbook.
objExcel.Workbooks.Add
 
'Change this to fit your server situation
Select Case UCase(strComputer)
  Case "ALL"
    PrintServer("CCPS01")
    Sheet = Sheet + 1
    PrintServer("IRGFS01")
    Sheet = Sheet + 1
    PrintServer("CCFLDR01")
  Case Else
    PrintServer(strComputer)
End Select
 
Function PrintServer(strComputer)
 
k=2
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Printer",,48)
 
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(Sheet)
objSheet.Name = strComputer
 
' Populate spreadsheet cells with printer attributes.
objSheet.Cells(1, 1).Value = "SERVEUR"
objSheet.Cells(1, 2).Value = "Name"
objSheet.Cells(1, 3).Value = "ShareName"
objSheet.Cells(1, 4).Value = "DriverName"
objSheet.Cells(1, 5).Value = "Location"
objSheet.Cells(1, 6).Value = "PortName"
objSheet.Cells(1, 7).Value = "Published"
objSheet.Cells(1, 8).Value = "Queued"
objSheet.Cells(1, 9).Value = "Shared"
 
 
For Each objItem in colItems
 
'put error code into human readable form
Select Case objItem.DetectedErrorState
  Case 4
    ErrState = "Out of Paper"
  Case 5
    ErrState = "Toner low"
  Case 6
    ErrState = "Printing"
  Case 9
    ErrState = "Offline"
  Case Else
    ErrState = objItem.DetectedErrorState
End Select
 
'populate the row with this printer's data
objSheet.Cells(k, 1).Value = strComputer
objSheet.Cells(k, 2).Value = objItem.Name
objSheet.Cells(k, 3).Value = objItem.ShareName
objSheet.Cells(k, 4).Value = objItem.DriverName
objSheet.Cells(k, 5).Value = objItem.Location
objSheet.Cells(k, 6).Value = objItem.PortName
objSheet.Cells(k, 7).Value = objItem.Published
objSheet.Cells(k, 8).Value = objItem.Queued
objSheet.Cells(k, 9).Value = objItem.Shared
 
k = k + 1
Next
 
' Format the spreadsheet.
objSheet.Range("A1:M1").Font.Bold = True
objSheet.Select
objSheet.Range("A2").Select
objExcel.ActiveWindow.FreezePanes = True
objExcel.Columns(3).ColumnWidth = 25
objExcel.Columns(5).ColumnWidth = 25
objExcel.Columns(6).ColumnWidth = 10
objExcel.Columns(8).ColumnWidth = 25
objExcel.Columns(1).ColumnWidth = 20
objExcel.Columns(9).ColumnWidth = 14
objExcel.Columns(2).ColumnWidth = 15
End Function
 
' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
 
' Quit Excel.
objExcel.Application.Quit
 
' Clean Up
Set objUser = Nothing
Set objGroup = Nothing
Set objSheet = Nothing
Set objExcel = Nothing
 
WScript.Echo "Printer listing is done"

**l_autodidacte** · 19/03/2014, 22h27

Salut et Bienvenu sur DVP

Il y a beaucoup à faire dans ce script pour qu'il réponde à ton besoin. Je l'ai hâtivement modifié , il a alors l'aspect suivant:

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
On Error Resume Next
 
 Const ForReading = 1
 Dim strComputer, strExcelPath, objExcel, objSheet, k, objGroup
 Dim objWMIService, colItems, ErrState, Sheet
 Dim FSO, Fich_A_Lire, WS 
 
    Set WS = CreateObject("WScript.Shell")
    'Sheet = spreadsheet page, k = row In sheet
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fich_A_Lire = FSO.OpenTextFile("Servers.txt", ForReading, False)
    Sheet = 1
    k = 1
    strExcelPath = "C:\Temp\" ' Chemin de test ici, à modifier selon le besoin et là c'est pour éviter l'InputBox
    strExcelPath = strExcelPath & "Printers_" & strComputer & ".xls"
    'On Error Resume Next
    Set objExcel = CreateObject("Excel.Application")
    If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Excel application not found."
        Wscript.Quit
    End If
    objExcel.Workbooks.Add
 
    Do While Not Fich_A_Lire.AtEndOfStream
            strComputer = TRim(Fich_A_Lire.ReadLine) ' On utilse TRim pour éviter les espaces de début ou de fin inutiles
            If strComputer = "" then
                MsgBox "Nom de serveur incorrect"
                WScript.quit 0
            End If
            If VerifComputerName(strComputer) Then
                    k = k + 1
                    PrintServer K, strComputer
            End If
    Loop
    objExcel.ActiveWorkbook.SaveAs strExcelPath
    objExcel.ActiveWorkbook.Close
 
    '============================= 
    Function PrintServer(K, ComputerName)
 
        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
      Set colPrinterItems = objWMIService.ExecQuery("Select * from Win32_Printer",,48)         
        Set objSheet = objExcel.ActiveWorkbook.Worksheets(Sheet)
        'objSheet.Name = ComputerName
 
        objSheet.Cells(1, 1).Value = "SERVEUR"
        objSheet.Cells(1, 2).Value = "Name"
        objSheet.Cells(1, 3).Value = "ShareName"
        objSheet.Cells(1, 4).Value = "DriverName"
        objSheet.Cells(1, 5).Value = "Location"
        objSheet.Cells(1, 6).Value = "PortName"
        objSheet.Cells(1, 7).Value = "Published"
        objSheet.Cells(1, 8).Value = "Queued"
        objSheet.Cells(1, 9).Value = "Shared"
 
        For Each colItem In colPrinterItems
        'put error code into human readable form
            Select Case colItem.DetectedErrorState
                Case 4
                    ErrState = "Out of Paper"
                Case 5
                    ErrState = "Toner low"
                Case 6
                    ErrState = "Printing"
                Case 9
                    ErrState = "Offline"
                Case Else
                    ErrState = colItem.DetectedErrorState
            End Select
 
            'populate the row with this printer's data
            objSheet.Cells(k, 1).Value = ComputerName
            objSheet.Cells(k, 2).Value = colItem.Name
            objSheet.Cells(k, 3).Value = colItem.ShareName
            objSheet.Cells(k, 4).Value = colItem.DriverName
            objSheet.Cells(k, 5).Value = colItem.Location
            objSheet.Cells(k, 6).Value = colItem.PortName
            objSheet.Cells(k, 7).Value = colItem.Published
            objSheet.Cells(k, 8).Value = colItem.Queued
            objSheet.Cells(k, 9).Value = colItem.Shared
        Next
 
        objSheet.Range("A1:M1").Font.Bold = True
        objSheet.Range("A1:M1").Font.Size = 11
        objSheet.Select
        objSheet.Range("A2").Select
        objExcel.ActiveWindow.FreezePanes = True
        objExcel.Columns(3).ColumnWidth = 25
        objExcel.Columns(5).ColumnWidth = 25
        objExcel.Columns(6).ColumnWidth = 10
        objExcel.Columns(8).ColumnWidth = 25
        objExcel.Columns(1).ColumnWidth = 20
        objExcel.Columns(9).ColumnWidth = 14
        objExcel.Columns(2).ColumnWidth = 15
    End Function
'========================================== 
 Function VerifComputerName(strCMPTR)
 
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
  Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) 
  For Each objItem in colItems 
        If UCase(objItem.Name) = UCase(strCMPTR) Then 
            VerifComputerName = True
            Exit For            
        End If
    Next
End Function
'==========================================    
    ' Quit Excel.
    objExcel.Quit
    objExcel.Terminate 
    ' Clean Up
    Set objUser = Nothing
    Set objGroup = Nothing
    Set objSheet = Nothing
    Set objExcel = Nothing
 
    WS.PopUp "Printer listing is done", 3 ,"Finished", 0

Mais il y a certes mieux que cela. A toi de creuser un peu plus.

**stanyslassz** · 23/03/2014, 18h27

Merci c'est bon!

Envoyé par l_autodidacte

Salut et Bienvenu sur DVP

Il y a beaucoup à faire dans ce script pour qu'il réponde à ton besoin. Je l'ai hâtivement modifié , il a alors l'aspect suivant:

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
On Error Resume Next
 
 Const ForReading = 1
 Dim strComputer, strExcelPath, objExcel, objSheet, k, objGroup
 Dim objWMIService, colItems, ErrState, Sheet
 Dim FSO, Fich_A_Lire, WS 
 
    Set WS = CreateObject("WScript.Shell")
    'Sheet = spreadsheet page, k = row In sheet
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fich_A_Lire = FSO.OpenTextFile("Servers.txt", ForReading, False)
    Sheet = 1
    k = 1
    strExcelPath = "C:\Temp\" ' Chemin de test ici, à modifier selon le besoin et là c'est pour éviter l'InputBox
    strExcelPath = strExcelPath & "Printers_" & strComputer & ".xls"
    'On Error Resume Next
    Set objExcel = CreateObject("Excel.Application")
    If Err.Number <> 0 Then
        On Error GoTo 0
        Wscript.Echo "Excel application not found."
        Wscript.Quit
    End If
    objExcel.Workbooks.Add
 
    Do While Not Fich_A_Lire.AtEndOfStream
            strComputer = TRim(Fich_A_Lire.ReadLine) ' On utilse TRim pour éviter les espaces de début ou de fin inutiles
            If strComputer = "" then
                MsgBox "Nom de serveur incorrect"
                WScript.quit 0
            End If
            If VerifComputerName(strComputer) Then
                    k = k + 1
                    PrintServer K, strComputer
            End If
    Loop
    objExcel.ActiveWorkbook.SaveAs strExcelPath
    objExcel.ActiveWorkbook.Close
 
    '============================= 
    Function PrintServer(K, ComputerName)
 
        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
      Set colPrinterItems = objWMIService.ExecQuery("Select * from Win32_Printer",,48)         
        Set objSheet = objExcel.ActiveWorkbook.Worksheets(Sheet)
        'objSheet.Name = ComputerName
 
        objSheet.Cells(1, 1).Value = "SERVEUR"
        objSheet.Cells(1, 2).Value = "Name"
        objSheet.Cells(1, 3).Value = "ShareName"
        objSheet.Cells(1, 4).Value = "DriverName"
        objSheet.Cells(1, 5).Value = "Location"
        objSheet.Cells(1, 6).Value = "PortName"
        objSheet.Cells(1, 7).Value = "Published"
        objSheet.Cells(1, 8).Value = "Queued"
        objSheet.Cells(1, 9).Value = "Shared"
 
        For Each colItem In colPrinterItems
        'put error code into human readable form
            Select Case colItem.DetectedErrorState
                Case 4
                    ErrState = "Out of Paper"
                Case 5
                    ErrState = "Toner low"
                Case 6
                    ErrState = "Printing"
                Case 9
                    ErrState = "Offline"
                Case Else
                    ErrState = colItem.DetectedErrorState
            End Select
 
            'populate the row with this printer's data
            objSheet.Cells(k, 1).Value = ComputerName
            objSheet.Cells(k, 2).Value = colItem.Name
            objSheet.Cells(k, 3).Value = colItem.ShareName
            objSheet.Cells(k, 4).Value = colItem.DriverName
            objSheet.Cells(k, 5).Value = colItem.Location
            objSheet.Cells(k, 6).Value = colItem.PortName
            objSheet.Cells(k, 7).Value = colItem.Published
            objSheet.Cells(k, 8).Value = colItem.Queued
            objSheet.Cells(k, 9).Value = colItem.Shared
        Next
 
        objSheet.Range("A1:M1").Font.Bold = True
        objSheet.Range("A1:M1").Font.Size = 11
        objSheet.Select
        objSheet.Range("A2").Select
        objExcel.ActiveWindow.FreezePanes = True
        objExcel.Columns(3).ColumnWidth = 25
        objExcel.Columns(5).ColumnWidth = 25
        objExcel.Columns(6).ColumnWidth = 10
        objExcel.Columns(8).ColumnWidth = 25
        objExcel.Columns(1).ColumnWidth = 20
        objExcel.Columns(9).ColumnWidth = 14
        objExcel.Columns(2).ColumnWidth = 15
    End Function
'========================================== 
 Function VerifComputerName(strCMPTR)
 
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
  Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) 
  For Each objItem in colItems 
        If UCase(objItem.Name) = UCase(strCMPTR) Then 
            VerifComputerName = True
            Exit For            
        End If
    Next
End Function
'==========================================    
    ' Quit Excel.
    objExcel.Quit
    objExcel.Terminate 
    ' Clean Up
    Set objUser = Nothing
    Set objGroup = Nothing
    Set objSheet = Nothing
    Set objExcel = Nothing
 
    WS.PopUp "Printer listing is done", 3 ,"Finished", 0

Mais il y a certes mieux que cela. A toi de creuser un peu plus.

[Help Plz) Extractions multiples dans un fichier Excel , listing imprimantes

VBScript

Vue hybride

Discussions similaires

Partager

Partager