On Error Resume Next


'===============================================================
'Программка на Visual Basic Script
'для прямого подключения к ODBC
'и заливки результата SQL запроса в Excel
'
'абсолютно несекурно и очень просто
'очень удобно делать простенькие отчеты для шефа :)
'
'Вопросы и замечания - на сайт http://rkorepanov.narod.ru
'================================================================
  Set db = Wscript.CreateObject("ADODB.Connection") 
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set XL = WScript.CreateObject("Excel.Application")
  set WshShell = CreateObject("WScript.Shell")

  db.Open "DSN=TMDOC;UID=User;PWD=Password;" ' Здесь вбиваешь ДСН и пароль
'  SQLQuery=InputBox ("Enter SQL query", "VBS-SQL", "Select * From 2.dbf", 1, 1)
  SQLQuery = "Select * From d_no" ' <- меняешь SQL запрос!

  XL.Visible = TRUE
  XL.WorkBooks.Add

  Set rs = db.Execute(SQLQuery) 
 for i = 0 to rs.fields.count - 1
j=j+1
	XL.Cells(1, j).Value = rs.fields(i).name
 next

XL.Range("1:1").Select
XL.Selection.Font.Bold = True
XL.Selection.Interior.ColorIndex = green
XL.Selection.Font.ColorIndex = 2
XL.Selection.HorizontalAlignment = &hFFFFEFDD ' xlLeft

intIndex=2
Do While NOT Rs.EOF
	
 for l = 0 to rs.fields.count - 1
	XL.Cells(intIndex, l+1).Select
	XL.Cells(intIndex, l+1).Value = rs.Fields(rs.fields(l).name).value 
        Xl.Cells(intIndex, l+1).EntireColumn.AutoFit
 next

Rs.MoveNext
 intIndex=intIndex+1
 XL.Cells(intIndex, 1).Select
Loop

db.Close
Set db = Nothing
WshShell.sendkeys "^{Home}" '  на начало страницы
'WshShell.sendkeys "^{f}"' Поиск

'XL.WorkBooks.SaveAs("c:\"&objNet.ComputerName&".xls")
XL.WorkBooks.SaveAs("c:\odbx.xls")
XL.Quit