Click here to monitor SSC
SQLServerCentral is supported by Red Gate Software Ltd.
 
Log in  ::  Register  ::  Not logged in
 
 
 
        
Home       Members    Calendar    Who's On


Add to briefcase ««12

Scripted Server Snapshot Expand / Collapse
Author
Message
Posted Wednesday, July 20, 2005 1:12 AM
SSC-Enthusiastic

SSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-Enthusiastic

Group: General Forum Members
Last Login: Tuesday, April 19, 2011 1:27 AM
Points: 116, Visits: 59

You're righth Robert.  Thanks for the tip.

I didn't like CopyFromRecordSet because I used to have lots of problems with it in earlier versions of Excel.  Now I managed to create a +100 MB Excel file with Excel 2002.  It looks like the limitations are gone.

The updated code can be found on

http://users.telenet.be/frederik.vandeputte/blog/2005/07/anyquery2excelvbs.html

Post #202661
Posted Thursday, July 13, 2006 1:46 AM
SSC-Enthusiastic

SSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-EnthusiasticSSC-Enthusiastic

Group: General Forum Members
Last Login: Tuesday, September 10, 2013 12:34 PM
Points: 142, Visits: 132

I like the anyQuery script, Frederik, but here's a script with results more like the original.

'http://www.sqlservercentral.com/columnists/rcarlson/scriptedserversnapshot.asp
Dim srvname
If WScript.Arguments.count > 0 Then
 srvname = WScript.Arguments(0)
Else
 srvname = InputBox ( "Enter the server Name", "srvname", ".")
End If
Const adOpenStatic = 3
Const adLockOptimistic = 3
Dim i
' making the connection to your sql server
' change yourservername to match your server
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

' this is using the trusted connection if you use sql logins
' add username and password, but I would then encrypt this
' using Windows Script Encoder
conn.Open "Provider=SQLOLEDB;Data Source=" & _
  srvname & ";Trusted_Connection=Yes;Initial Catalog=Master;"
       
' creating the Excel object application
Set xl = CreateObject("Excel.Application")

xl.Visible = True

Set objWorkbook = xl.Workbooks.Add()
Set ws = objWorkbook.Worksheets(1)

' The query goes here
rs.Open "sp_who2 ", _
        conn, adOpenStatic, adLockOptimistic
i = 1

rs.MoveFirst

' This is setting the column names, font, colors, etc.
' This code can be simplified by ranging if desired.
c = 1
If Not rs.EOF Then
    For Each col In rs.Fields
        ws.Cells(1, c).Value = col.Name
        ws.Cells(1, c).Font.Bold = True
        c = c + 1
    Next
Else
    ws.Cells(1, c).Value = "Query returned no results"
End If

ws.Range("A2").CopyFromRecordset rs

with ws
   with .Range("A1:M1")
 .Font.Bold = True
 .Interior.ColorIndex = 6
   end with
   with .Range("A:M")
 .Font.Size = 10
 .Borders.LineStyle = True
   end with
    with .Range(.Cells(2, 3), .Cells(ws.UsedRange.Rows.Count, 3))
 .Interior.ColorIndex = 6
 .Font.ColorIndex = 49
    end with
    with .Range(.Cells(2, 8), .Cells(ws.UsedRange.Rows.Count, 8))
  .Interior.ColorIndex = 6
  .Font.ColorIndex = 49
    end with
end with

Const xlPart = 2
ws.UsedRange.Replace "          "," ", xlPart
ws.UsedRange.Replace "    "," ", xlPart
ws.UsedRange.Replace "  "," ", xlPart
' automatically fits the data to the columns
ws.UsedRange.EntireColumn.Autofit()
ws.Range("B1").EntireColumn.Hidden = True
ws.Range("E1").EntireColumn.Hidden = True

'The following coverts column H from strings into numbers so that it is sortable:
'Some references for these pesky constants:
'http://mi4.com/blog/index.php?blog=5&p=28&more=1&c=1&tb=1&pb=1
'http://fox.wikis.com/wc.dll?Wiki~ExcelConstants~VFP
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaxl11/html/xlhowConstants_HV01049962.asp
'http://www.p6c.com/CommonTypelibs/O2000_EXCEL9.html
Const xlDown = -4121
Const xlPasteValues = -4163
Const xlAdd = 2
ws.Range(ws.Range("H1"), ws.Range("H1").End(xlDown)).NumberFormat = "0"
ws.Range("H1").End(xlDown).Offset(1,0).Select
xl.Selection.FormulaR1C1 = "0"
xl.Selection.Copy
ws.Range(ws.Range("H1"), ws.Range("H1").End(xlDown)).PasteSpecial xlPasteValues, xlAdd, False, False
ws.Range("H1").End(xlDown).ClearContents
ws.Application.CutCopyMode = False

ws.Range("A2").EntireRow.Select
xl.ActiveWindow.FreezePanes = True
ws.Range("A1").Select

' cleaning up
rs.Close
conn.Close

Post #293989
« Prev Topic | Next Topic »

Add to briefcase ««12

Permissions Expand / Collapse