Private Sub InExcel97_2003_Click(Index As Integer)
AttentionForm.Visible = True
  
  Dim rs As Recordset
  Set rs = ResultForm.DataMain.Recordset.Clone
  
  rs.MoveFirst
  
  Dim MyDate As String
  MyDate = str(Format$(Now(), "ddmmyyyyhhmm"))
    
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application.11")
   Set oBook = oExcel.Workbooks.Open("c:\Arka\main.xls")
   Set oSheet = oBook.Worksheets("Результат")
   Dim iCols As Integer
   
   'Очистка таблицы Экселя
    oSheet.Cells.Select
    oExcel.Selection.ClearContents
    oSheet.Range("A1").Select
   
'Передаем названия столбцов

    For iCols =  0  To rs.Fields.Count -  1 
    oExcel.Cells( 1 , iCols +  1 ).Value = rs.Fields(iCols).Name
    Next
    oExcel.Range(oSheet.Cells( 1 ,  1 ), oSheet.Cells( 1 , rs.Fields.Count)).Font.Bold = True

'Передаем данные
    oExcel.Range("A2").CopyFromRecordset rs

'Форматируем столбцы
    oExcel.Cells.Select
    oExcel.Selection.Columns.AutoFit
    oExcel.Range("A1").Select
   
'Сохранить книгу и закрыть Excel
'Проверка существования исходящей директории
    If nasDirExists("c:\Reports\") Then
        oBook.SaveAs FileName:="c:\Reports\" & MyDate & ".xls"
         AttentionForm.Hide
        MsgBox "Экспорт в папку C:\Reports\ успешно завершен",  64 , "Операция завершена"
    Else
    
    Select Case MsgBox("Целевая папка c:\Reports\ не найдена. Создать?",  52 , "Внимание!!!")
        Case  6  ' Да
            MkDir ("c:\Reports")
            oBook.SaveAs FileName:="c:\Reports\" & MyDate & ".xls"
            AttentionForm.Hide
            MsgBox "Целевая папка C:\Reports\ успешно создана." & vbCrLf & "Экспорт завершен",  64 , "Экспорт"
        Case  7  ' Нет
            oExcel.Cells.Select
            oExcel.Selection.ClearContents
            oExcel.Range("A1").Select
            oBook.Save
            AttentionForm.Hide
            MsgBox "Вы отказались от экспорта",  64 , "Операция не завершена"
End Select
    
    End If
 ' Разорвать соединение
    oBook.Save
    oExcel.Quit
    Set oExcel = Nothing
    rs.Close
    Set rs = Nothing
 End Sub