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