Dim sSQLString As String
    Dim objXL As Object
    Dim objWb As Object
    Dim objWs As Object

    Set objXL = CreateObject("Excel.Application")
    If objXL Is Nothing Then Exit Sub

    objXL.SheetsInNewWorkbook =  1 
    Set objWb = objXL.Workbooks.Add 'Open("c:\main.xls")
    Set objWs = objWb.Worksheets( 1 )

    objXL.Visible = True

      sSQLString = "Ваш Запрос"

    objWs.Cells( 1 ) = "Столбец 1"
    objWs.Cells( 2 ) = "Столбец 2"
    objWs.Cells( 3 ) = "Столбец 3"
    objWs.Cells( 4 ) = "Столбец 4"
    objWs.Cells( 5 ) = "Столбец 5"
    objWs.Range("A1:F1").Font.Bold = True
    objWs.Columns("A:F").AutoFit
    
    Set rs = Con.Execute(sSQLString)

    objWs.Range("A2").CopyFromRecordset rs 'передача данных
    
    objWs.Cells.Select
    objXL.Selection.Columns.AutoFit
    objWs.Range("A1").Select
        
    Set rs = Nothing

Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")

    'sSQLString = "Ваш Запрос"
    'Set rs = Con.Execute(sSQLString)
    'objWs.Range("A2").CopyFromRecordset rs 'передача данных

 objWs.Cells( 1 ) = "Столбец 1"
    objWs.Cells( 2 ) = "Столбец 2"
    objWs.Cells( 3 ) = "Столбец 3"
    objWs.Cells( 4 ) = "Столбец 4"
    objWs.Cells( 5 ) = "Столбец 5"