Sub ToExcelFinal_2()
On Error GoTo Err_
Dim xlApp As Object, xlBook As Object, xlSheet As Object
Dim rsd As DAO.Recordset
Dim i As Byte

    Set xlApp = CreateObject("Excel.Application")
   
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    
    Set rsd = CurrentDb.OpenRecordset("SELECT tFizlicaReestr.LS AS ЛС, tFizlicaReestr.FIO AS ФИО , tFizlicaReestr.Adres AS Адрес, Null AS Оплата" & _
                                     " FROM tFizlicaReestr INNER JOIN tRabotaReestr ON tFizlicaReestr.LS = tRabotaReestr.LS " & _
                                     " WHERE tRabotaReestr.DataDobavleniaGraf = #" & Format([Forms]![fExpExcel]![pData], "mm\/dd\/yyyy") & "# " & _
                                     " GROUP BY tFizlicaReestr.LS, tFizlicaReestr.FIO, tFizlicaReestr.Adres, Null " & _
                                     " ORDER BY tFizlicaReestr.LS", dbOpenSnapshot)
    For i = 0 To rsd.Fields.Count - 1
        xlSheet.Cells(1, i + 1) = rsd.Fields(i).Name
    Next i
    xlSheet.Range("A2").CopyFromRecordset rsd
    xlSheet.Columns(1).Autofit
    xlSheet.Columns(2).Autofit
    xlSheet.Columns(3).Autofit
    
    rsd.Close
     
    Set rsd = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlApp = Nothing
        
Exit Sub
Err_:
End Sub