• Во первых на машине должен быть установлен Visual Basic v 5.0 или выше.
• Запускаем EXCEL и клавишами Alt-F11 переходим в режим программирования.
• Подключаем OLE DB к EXCEL. Выбираем в меню Tools->References и ставим галочку напротив MS OLE DB ActiveX Data Objects.

Public Sub Report()
  Dim sQuery As String
  Dim Rs As ADODB.Recordset
  Dim Base As ADODB.Connection
  Dim i As Integer

  Const sServer = "DATABANK"  'Имя сервера
  Const sBase = "ProSystem"   'Имя базы

  'Устанавливаем соединение
  Set Base = New ADODB.Connection
  sQuery = "driver={SQL Server};server=" & _
  	sServer & ";database=  " & sBase&";uid=sa;pwd=;"
  Base.Open (sQuery)

  'Выполняем запрос к базе 
   Set Rs = Base.Execute("select id, name from test order by name")
 
  'Выбираем результат (для примера в combobox)
   i=0
   While Not Rs.EOF
      .cmb.AddItem
      .cmb.List(i, 0) = Rs.Fields(1).Value
      .cmb.List(i, 1) = Rs.Fields(0).Value
      Rs.MoveNext
      i = i + 1
   Wend
   
   'Все закрываем
   Rs.Close
   Base.Close
End Sub

Dim excel_cn
set excel_cn = Server.CreateObject("ADODB.Connection")
on error resume next
excel_cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&XLS_NAME&";Extended Properties=Excel 8.0;"
If err.Number <> 0 then
  set cn = Nothing
  Response.End 
End If
on error goto 0

Dim rs_excel
Set rs_excel = Server.CreateObject("ADODB.Recordset")
Dim sql_str
sql_str = " select * from `Paper$`"
on error resume next
rs_excel.open sql_str,excel_cn,adOpenStatic
If err.Number <> 0 then
  set cn = Nothing
  Response.End 
End If
on error goto 0

do while not rs_excel.EOF
 rs_excel.movenext
loop
rs_excel.close
Set rs_excel = nothing
excel_cn.close
Set excel_cn = nothing

Set cnXls= Server.CreateObject("ADODB.Connection")
cnXls.Provider = "MSDASQL"
cnXls.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & sFileName & "; ReadOnly=False;"
On error resume next
cnXls.Open
if Err.number <> 0 then
	sMessage = "Неверный формат файла."
	Err.Clear
end if	
On error goto 0

sSheet= Array("INDICES","CHIPS")
for n = LBound(sSheet) to UBound(sSheet)

On error resume next
sQuery = "SELECT * FROM [" & sSheet(n) & "$]"
Set rsXls= cnXls.Execute(sQuery)

if Err.number <> 0 then
	sMessage = "Неверный формат файла. Отсутствует страница " & sSheet(n)
	Err.Clear
end if	

'Контроль наличия необходимых полей
On error resume next
For Each fld In rsSql.Fields
	sName = fld.Name
	if Left(sName,2) = "m_" then
		t= rsXls.Fields( UCase(Mid(sName,3)) ).Name
		if Err.number <> 0 then
			sMessage = "Неверный формат файла. Поле " & UCase(Mid(sName,3)) & " не найдено "
			Err.Clear
		exit for
		end if
	end if	
Next
On error goto 0

do until rsXls.eof
		
	rsSql.Fields(sName).Value = rsXls.Fields( UCase(Mid(sName,3)) ).Value
	rsXls.MoveNext
Loop
Next

Dim Ex As Excel.Application
Dim Wb As Excel.Workbook
Dim Sh As Excel.Worksheet
Dim rs As ADODB.Recordset
Dim s As String
Dim c As Integer
Dim iLineCount As Integer
Dim fld,r,val
    
Set Ex = New Excel.Application
Ex.Visible = False
Set Wb = Ex.Workbooks.Add(sFileName)
    
s = "pl_logo,pl_time,pl_name,pl_timing,..."
fld = Split(s, ",")
	
For Each Sh In Wb.Worksheets

    Set rs = New ADODB.Recordset
    rs.Open "select * from ut_playlist", CurrentProject.Connection, 1, 3, 8
	
    iLineCount = 2
    Do
          'Бежим по строкам
          s = Sh.Cells(iLineCount, 1)
          If Len(s) = 0 Then Exit Do
          
          'Бежим по колонкам
          For c = 2 To 12
            val = Sh.Cells(iLineCount, c)
            If c = 3  Then
               s = Format(val, "00\:00\:00\:00")
            Else
               s = Trim("" & val)
            End If
            r(c - 1) = s
          Next
	
	
	      rs.AddNew
    	  For i = 0 To iFieldCount - 1
        	On Error Resume Next
	        If Len(r(i)) = 0 Then
    	        rs.Fields(fld(i)).Value = Null
        	Else
            	Dim fd As ADODB.Field
	            Set fd = rs.Fields(fld(i))
    	        If fd.Type = adVarChar Then
        	        fd.Value = Left("" & r(i), fd.DefinedSize)
            	Else
                	fd.Value = "" & r(i)
	            End If
    	    End If
	      Next
    	  rs.Update
	
          iLineCount = iLineCount + 1
    Loop
    rs.Close
    Set rs = Nothing
	
Next

Ex.Quit
Set Ex = Nothing
	

string	excs = "Provider=Microsoft.Jet.OleDb.4.0;Data Source="+sfn;
excs += ";Extended Properties=\"Excel 8.0; HDR=1; IMEX=1;\"";

i_chan = DDEInitiate("EXCEL", "System")
DDEExecute i_chan, "[Open(""C:\EXCEL\BOOK1.XLS"")]"

i_chan = DDEInitiate("EXCEL", "SHEET1")
ret_num = DDERequest(i_chan, "R1C1")

 
Row = "L" & Rownum & "C1:L" & Rownum & "C" & rs.Fields.count 
DDEPoke Chan, Row, Cell