• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1479
  • Last Modified:

Export the VB script output to Excel Spreadsheet.

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
sujithmd
Asked:
sujithmd
  • 6
  • 3
  • 3
1 Solution
 
RobSampsonCommented:
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
 
prashanthdCommented:
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
 
sujithmdAuthor Commented:
@ RobSampson - your script works well as you said  - Thanks

@ prashanthd - i'm getting a syntax error while executing the same.
Capture.JPG
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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

Regards,

Rob.
0
 
sujithmdAuthor Commented:
Thanks Rob If you can make that xls to working that is excellent
0
 
prashanthdCommented:
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
 
prashanthdCommented:
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
 
sujithmdAuthor Commented:
Thanks its working now
0
 
sujithmdAuthor Commented:
 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
 
sujithmdAuthor Commented:
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
 
RobSampsonCommented:
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
 
sujithmdAuthor Commented:
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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 6
  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now