Private Sub ExportToExcel()
  Dim rst As Recordset
  Dim strSQL As String
  Dim strPath As String
  Dim xlApp As Excel.Application
  Dim xlWb As Excel.Workbook
  Dim xlWs As Excel.Worksheet
  Dim i As Integer, CountColumn As Integer
  
  Dim lngLastRow As Long
  Dim lngLastColumn As Long

On Error GoTo ErrNumber
  If (strWHERE = "") Or (strWHERE = "КодЗаявки Is Null") Then
    MsgBox "Нет ни одного критерия для экспорта данных.", vbInformation + vbOKOnly, "Info"
    Exit Sub
  Else
    strSQL = "SELECT * FROM звПоиск WHERE " & strWHERE
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets(1)
    Set rst = CurrentDb.OpenRecordset(strSQL)
    CountColumn = rst.Fields.Count 'Узнаем количество колонок в Recordset
    For i = 0 To CountColumn - 1
      xlWs.Range("A1").Offset(0, i).Value = rst.Fields(i).Name
      xlWs.Rows(1).WrapText = False 'Перенос по словам
'Выравнивание
      xlWs.Rows(1).HorizontalAlignment = xlCenter
      xlWs.Rows(1).VerticalAlignment = xlCenter
      xlWs.Rows(1).Interior.ColorIndex = 15 'Цвет фона
    Next i
    xlWs.Range("A2").CopyFromRecordset rst 'экспорт запроса в excel
    rst.Close
    
    xlWs.Range("A1:A1").Select
    lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'на этой строке срабатывает ошибка
    lngLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    xlWs.Range(Cells(1, 1), Cells(lngLastRow, lngLastColumn)).WrapText = False
'удаляем лишние листы в книге
    If xlWb.Sheets.Count > 1 Then
      For Each xlWs In xlWb.Worksheets
        If xlWs.Index <> 1 Then
          xlWs.Delete
        End If
      Next
    End If
'    strPath = GetUserDesktop
'    strPath = CurrentProject.Path & "\Отчет " & Format(Date, "dd.mm.yyyy") & "_" & Format(Time, "hh-mm-ss") & ".xls"
'    xlWs.SaveAs strPath
    xlApp.visible = True
  End If
ExitHeare:
  Set rst = Nothing
  Set xlWs = Nothing
  Set xlWb = Nothing
  Set xlApp = Nothing
Exit Sub

ErrNumber:
  If Error <> 0 Then
    MsgBox Err.Description, , _
      "№ " & Err.Number & ". Процедура: ExportToExcel. Форма: " & Me.Name
    Resume ExitHeare
  End If
End Sub