Solved

Export the VB script output to Excel Spreadsheet.

Posted on 2011-02-22
12
1,421 Views
Last Modified: 2013-12-01
Hello Scripting Gurus this script will echo all the print queues and corresponding print servers it configured in a domain all I need is the output to be saved in a spreadsheet with one column as Print Queue and other column as Print Server. Hope any scripting gurus can help me.!!!!!


' List All Published Printers

' Windows Server 2003 : Yes
' Windows XP : Yes
' Windows 2000 : Yes
' Windows NT 4.0 : Yes
' Windows 98 : Yes

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select printerName, serverName from " _     
    & " 'LDAP://DC=fabrikam,DC=com'  where objectClass='printQueue'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

Do Until objRecordSet.EOF
    Wscript.Echo "Printer Name: " & objRecordSet.Fields("printerName").Value
    Wscript.Echo "Server Name: " & objRecordSet.Fields("serverName").Value
    objRecordSet.MoveNext
Loop

Open in new window

0
Comment
Question by:sujithmd
  • 6
  • 3
  • 3
12 Comments
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 34958018
Hi, try this for a CSV.

Regards,

Rob.
' List All Published Printers

' Windows Server 2003 : Yes
' Windows XP : Yes
' Windows 2000 : Yes
' Windows NT 4.0 : Yes
' Windows 98 : Yes

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select printerName, serverName from " _     
    & " 'LDAP://DC=fabrikam,DC=com'  where objectClass='printQueue'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

strOutput = "Printers.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.CreateTextFile(strOutput, True)

Do Until objRecordSet.EOF
    objOutput.WriteLine """" & objRecordSet.Fields("printerName").Value & """,""" & objRecordSet.Fields("serverName").Value & """"
    'Wscript.Echo "Printer Name: " & objRecordSet.Fields("printerName").Value
    'Wscript.Echo "Server Name: " & objRecordSet.Fields("serverName").Value
    objRecordSet.MoveNext
Loop

objOutput.Close

MsgBox "Done. Please see " & strOutput

Open in new window

0
 
LVL 12

Expert Comment

by:prashanthd
ID: 34958053
You can try this code for .xls

Option Explicit

Dim objUser, strExcelPath, objExcel, objSheet, k, objGroup

Const xlExcel7 = 39

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

strExcelPath = "c:\Printers.xls"

' 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


Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select printerName, serverName from " _    
& " 'LDAP://DC=fabrikam,DC=com'  where objectClass='printQueue'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
objExcel.Workbooks.Add
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Printers"
objSheet.Cells(1, 1).Value = "Print Queue"
objSheet.Cells(2, 1).Value = "Server Name"
k = 2

Do Until objRecordSet.EOF
    'Wscript.Echo "Printer Name: " & objRecordSet.Fields("printerName").Value
    'Wscript.Echo "Server Name: " & objRecordSet.Fields("serverName").Value
    objSheet.Cells(k, 1).Value = objRecordSet.Fields("printerName").Value
    objSheet.Cells(k, 2).Value = objRecordSet.Fields("serverName").Value
    k = k + 1
    objRecordSet.MoveNext
Loop


' Format the spreadsheet.
objSheet.Range("A1:A2").Font.Bold = True
objSheet.Select
objSheet.Range("B5").Select
objExcel.ActiveWindow.FreezePanes = True
objExcel.Columns(1).ColumnWidth = 20
objExcel.Columns(2).ColumnWidth = 30

' Save the spreadsheet and close the workbook.
' Specify Excel7 File Format.
objExcel.ActiveWorkbook.SaveAs strExcelPath, xlExcel7
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

WScript.Echo "Done"
0
 
LVL 5

Author Comment

by:sujithmd
ID: 34983025
@ RobSampson - your script works well as you said  - Thanks

@ prashanthd - i'm getting a syntax error while executing the same.
Capture.JPG
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 34986032
Do you need anything else? If you want it to output directly to Excel, I can help get that working too.

Regards,

Rob.
0
 
LVL 5

Author Comment

by:sujithmd
ID: 34986996
Thanks Rob If you can make that xls to working that is excellent
0
 
LVL 12

Expert Comment

by:prashanthd
ID: 34987857
Try the below code, just removed option explicit


Dim objUser, strExcelPath, objExcel, objSheet, k, objGroup

Const xlExcel7 = 39

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

strExcelPath = "c:\Printers.xls"

' 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


Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select printerName, serverName from " _    
& " 'LDAP://DC=fabrikam,DC=com'  where objectClass='printQueue'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
objExcel.Workbooks.Add
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Printers"
objSheet.Cells(1, 1).Value = "Print Queue"
objSheet.Cells(1, 2).Value = "Server Name"
k = 2

Do Until objRecordSet.EOF
    'Wscript.Echo "Printer Name: " & objRecordSet.Fields("printerName").Value
    'Wscript.Echo "Server Name: " & objRecordSet.Fields("serverName").Value
    objSheet.Cells(k, 1).Value = objRecordSet.Fields("printerName").Value
    objSheet.Cells(k, 2).Value = objRecordSet.Fields("serverName").Value
    k = k + 1
    objRecordSet.MoveNext
Loop


' Format the spreadsheet.
objSheet.Range("A1:A2").Font.Bold = True
objSheet.Select
objSheet.Range("B5").Select
objExcel.ActiveWindow.FreezePanes = True
objExcel.Columns(1).ColumnWidth = 20
objExcel.Columns(2).ColumnWidth = 30

' Save the spreadsheet and close the workbook.
' Specify Excel7 File Format.
objExcel.ActiveWorkbook.SaveAs strExcelPath, xlExcel7
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

WScript.Echo "Done"
0
Backup Your Microsoft Windows Server®

Backup all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

 
LVL 12

Expert Comment

by:prashanthd
ID: 34987865
Try the below code, just removed option explicit


Dim objUser, strExcelPath, objExcel, objSheet, k, objGroup

Const xlExcel7 = 39

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

strExcelPath = "c:\Printers.xls"

' 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


Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select printerName, serverName from " _    
& " 'LDAP://DC=fabrikam,DC=com'  where objectClass='printQueue'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
objExcel.Workbooks.Add
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Printers"
objSheet.Cells(1, 1).Value = "Print Queue"
objSheet.Cells(1, 2).Value = "Server Name"
k = 2

Do Until objRecordSet.EOF
    'Wscript.Echo "Printer Name: " & objRecordSet.Fields("printerName").Value
    'Wscript.Echo "Server Name: " & objRecordSet.Fields("serverName").Value
    objSheet.Cells(k, 1).Value = objRecordSet.Fields("printerName").Value
    objSheet.Cells(k, 2).Value = objRecordSet.Fields("serverName").Value
    k = k + 1
    objRecordSet.MoveNext
Loop


' Format the spreadsheet.
objSheet.Range("A1:A2").Font.Bold = True
objSheet.Select
objSheet.Range("B5").Select
objExcel.ActiveWindow.FreezePanes = True
objExcel.Columns(1).ColumnWidth = 20
objExcel.Columns(2).ColumnWidth = 30

' Save the spreadsheet and close the workbook.
' Specify Excel7 File Format.
objExcel.ActiveWorkbook.SaveAs strExcelPath, xlExcel7
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

WScript.Echo "Done"
0
 
LVL 5

Author Comment

by:sujithmd
ID: 34988989
Thanks its working now
0
 
LVL 5

Author Comment

by:sujithmd
ID: 39586439
 Sub CalendarMaker()

       ' Unprotect sheet if had previous calendar to prevent error.
       ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
          Scenarios:=False
       ' Prevent screen flashing while drawing calendar.
       Application.ScreenUpdating = False
       ' Set up error trapping.
       On Error GoTo MyErrorTrap
       ' Clear area a1:g14 including any previous calendar.
       Range("a1:g14").Clear
       ' Use InputBox to get desired month and year and set variable
       ' MyInput.
       MyInput = InputBox("Type in Month and year for Calendar ")
       ' Allow user to end macro with Cancel in InputBox.
       If MyInput = "" Then Exit Sub
       ' Get the date value of the beginning of inputted month.
       StartDay = DateValue(MyInput)
       ' Check if valid date but not the first of the month
       ' -- if so, reset StartDay to first day of month.
       If Day(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & _
               Year(StartDay))
       End If
       ' Prepare cell for Month and Year as fully spelled out.
       Range("a1").NumberFormat = "mmmm yyyy"
       ' Center the Month and Year label across a1:g1 with appropriate
       ' size, height and bolding.
       With Range("a1:g1")
           .HorizontalAlignment = xlCenterAcrossSelection
           .VerticalAlignment = xlCenter
           .Font.Size = 18
           .Font.Bold = True
           .RowHeight = 35
       End With
       ' Prepare a2:g2 for day of week labels with centering, size,
       ' height and bolding.
       With Range("a2:aj2")
           .ColumnWidth = 11
           .VerticalAlignment = xlCenter
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           .Orientation = xlHorizontal
           .Font.Size = 12
           .Font.Bold = True
           .RowHeight = 20
       End With
       ' Put days of week in a2:g2.
       Range("a2") = "Sun"
       Range("b2") = "Mon"
       Range("c2") = "Tues"
       Range("d2") = "Wed"
       Range("e2") = "Thu"
       Range("f2") = "Fri"
       Range("g2") = "Sat"
       Range("h2") = "Sun"
       Range("i2") = "Mon"
       Range("j2") = "Tues"
       Range("k2") = "Wed"
       Range("l2") = "Thu"
       Range("m2") = "Fri"
       Range("n2") = "Sat"
       Range("o2") = "Sun"
       Range("p2") = "Mon"
       Range("q2") = "Tues"
       Range("r2") = "Wed"
       Range("s2") = "Thu"
       Range("t2") = "Fri"
       Range("u2") = "Sat"
       Range("v2") = "Sun"
       Range("w2") = "Mon"
       Range("x2") = "Tues"
       Range("y2") = "Wed"
       Range("z2") = "Thu"
       Range("aa2") = "Fri"
       Range("ab2") = "Sat"
       Range("ac2") = "Sun"
       Range("ad2") = "Mon"
       Range("ae2") = "Tues"
       Range("af2") = "Wed"
       Range("ag2") = "Thu"
       Range("ah2") = "Fri"
       Range("ai2") = "Sat"
       Range("aj2") = "Sun"
       
       ' Prepare a3:g7 for dates with left/top alignment, size, height
       ' and bolding.
'       With Range("a3:g8")
'           .HorizontalAlignment = xlRight
'           .VerticalAlignment = xlTop
'           .Font.Size = 18
'           .Font.Bold = True
'           .RowHeight = 21
'       End With
       ' Put inputted month and year fully spelling out into "a1".
       Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
       ' Set variable and get which day of the week the month starts.
       DayofWeek = Weekday(StartDay)
       ' Set variables to identify the year and month as separate
       ' variables.
       CurYear = Year(StartDay)
       CurMonth = Month(StartDay)
       ' Set variable and calculate the first day of the next month.
       FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
       ' Place a "1" in cell position of the first day of the chosen
       ' month based on DayofWeek.
       Select Case DayofWeek
           Case 1
               Range("a3").Value = 1
           Case 2
               Range("b3").Value = 1
           Case 3
               Range("c3").Value = 1
           Case 4
               Range("d3").Value = 1
           Case 5
               Range("e3").Value = 1
           Case 6
               Range("f3").Value = 1
           Case 7
               Range("g3").Value = 1
       End Select
       ' Loop through range a3:g8 incrementing each cell after the "1"
       ' cell.
       For Each cell In Range("a3:aj3")
           RowCell = cell.Row
           ColCell = cell.Column
           ' Do if "1" is in first column.
           If cell.Column = 1 And cell.Row = 3 Then
           ' Do if current cell is not in 1st column.
           ElseIf cell.Column <> 1 Then
               If cell.Offset(0, -1).Value >= 1 Then
                   cell.Value = cell.Offset(0, -1).Value + 1
                   ' Stop when the last day of the month has been
                   ' entered.
                   If cell.Value > (FinalDay - StartDay) Then
                       cell.Value = ""
                       ' Exit loop when calendar has correct number of
                       ' days shown.
                       Exit For
                   End If
               End If
           ' Do only if current cell is not in Row 3 and is in Column 1.
           ElseIf cell.Row > 3 And cell.Column = 1 Then
               cell.Value = cell.Offset(-1, 6).Value + 1
               ' Stop when the last day of the month has been entered.
               If cell.Value > (FinalDay - StartDay) Then
                   cell.Value = ""
                   ' Exit loop when calendar has correct number of days
                   ' shown.
                   Exit For
               End If
           End If
       Next

       ' Create Entry cells, format them centered, wrap text, and border
       ' around days.
'       For x = 0 To 5
'           Range("A4").Offset(x * 2, 0).EntireRow.Insert
'           With Range("A4:G4").Offset(x * 2, 0)
'               .RowHeight = 65
'               .HorizontalAlignment = xlCenter
'               .VerticalAlignment = xlTop
'               .WrapText = True
'               .Font.Size = 10
'               .Font.Bold = False
               ' Unlock these cells to be able to enter text later after
               ' sheet is protected.
'               .Locked = False
'           End With
           ' Put border around the block of dates.
'           With Range("A3").Offset(x * 2, 0).Resize(2, _
'           7).Borders(xlLeft)
'               .Weight = xlThick
'               .ColorIndex = xlAutomatic
'           End With

'           With Range("A3").Offset(x * 2, 0).Resize(2, _
'           7).Borders(xlRight)
'               .Weight = xlThick
'               .ColorIndex = xlAutomatic
'           End With
'           Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
'              Weight:=xlThick, ColorIndex:=xlAutomatic
'       Next
'       If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
'          .Resize(2, 8).EntireRow.Delete
       ' Turn off gridlines.
'       ActiveWindow.DisplayGridlines = False
       ' Protect sheet to prevent overwriting the dates.
'       ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
'          Scenarios:=True

       ' Resize window to show all of calendar (may have to be adjusted
       ' for video configuration).
       ActiveWindow.WindowState = xlMaximized
       ActiveWindow.ScrollRow = 1

       ' Allow screen to redraw with calendar showing.
       Application.ScreenUpdating = False
       ' Prevent going to error trap unless error found by exiting Sub
       ' here.
       
       
       
Range("f3").Value = Range("A1").Value
Range("f3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
       
   Range("A3:AJ3").Select
    Selection.NumberFormat = "d-mmm-yy"
       
       
       
       Exit Sub
   ' Error causes msgbox to indicate the problem, provides new input box,
   ' and resumes at the line that caused the error.
MyErrorTrap:
       MsgBox "You may not have entered your Month and Year correctly." _
           & Chr(13) & "Spell the Month correctly" _
           & " (or use 3 letter abbreviation)" _
           & Chr(13) & "and 4 digits for the Year"
       MyInput = InputBox("Type in Month and year for Calendar")
       If MyInput = "" Then Exit Sub
       Resume
   End Sub

Open in new window

0
 
LVL 5

Author Comment

by:sujithmd
ID: 39592095
Dim rng1 As Range
Dim c As Range
Set rng1 = Range("H2:AJ2")
For Each c In rng1

If c.Value = "Sat" Then

c.Select

ActiveCell.Range("A1:A19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If

If c.Value = "Sun" Then

c.Select
ActiveCell.Range("A1:A19").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
   
    
    
End If


Next

End Sub

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 39592545
The code you have posted above can be shortened to this:
Dim rng1 As Range
Dim c As Range
Set rng1 = Range("H2:AJ2")
For Each c In rng1
	If c.Value = "Sat" Or c.Value = "Sun" Then
		With Range("A1:A19").Interior
			.Pattern = xlSolid
			.PatternColorIndex = xlAutomatic
			.Color = 255
			.TintAndShade = 0
			.PatternTintAndShade = 0
		End With
	End If
Next

Open in new window


But it doesn't appear to have anything to do with your original code or question......do you need more assistance?

Regards,

Rob.
0
 
LVL 5

Author Comment

by:sujithmd
ID: 39596277
thanks Rob your shrinked version did helped as you said it doesn't have any relation to the orginal thread I just put it here to have keep the formating .
0

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A quick step-by-step overview of installing and configuring Carbonite Server Backup.
Storage devices are generally used to save the data or sometime transfer the data from one computer system to another system. However, sometimes user accidentally erased their important data from the Storage devices. Users have to know how data reco…
This tutorial will walk an individual through locating and launching the BEUtility application to properly change the service account username and\or password in situation where it may be necessary or where the password has been inadvertently change…
This tutorial will walk an individual through the steps necessary to install and configure the Windows Server Backup Utility. Directly connect an external storage device such as a USB drive, or CD\DVD burner: If the device is a USB drive, ensure i…

914 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now