Solved

Export the VB script output to Excel Spreadsheet.

Posted on 2011-02-22
12
1,409 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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

VM backup deduplication is a method of reducing the amount of storage space needed to save VM backups. In most organizations, VMs contain many duplicate copies of data, such as VMs deployed from the same template, VMs with the same OS, or VMs that h…
Are you looking to recover an email message or a contact you just deleted mistakenly? Or you are searching for a contact that you erased from your MS Outlook ‘Contacts’ folder and now realized that it was important.
This tutorial will walk an individual through the process of configuring basic necessities in order to use the 2010 version of Data Protection Manager. These include storage, agents, and protection jobs. Launch Data Protection Manager from the deskt…
This tutorial will walk an individual through setting the global and backup job media overwrite and protection periods in Backup Exec 2012. Log onto the Backup Exec Central Administration Server. Examine the services. If all or most of them are stop…

747 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

11 Experts available now in Live!

Get 1:1 Help Now