Private Sub btn_exp1_Click()
On Error GoTo Err_btn_exp1_Click

Dim myOlApp As Excel.Application
Dim MyWo As Excel.Workbook
Dim mysheet As Excel.Worksheet

Dim MyRst As ADODB.Recordset
Dim ct As Long
Dim m As Long


Set myOlApp = New Excel.Application
Set MyWo = myOlApp.Workbooks.Open("C:\Documents and Settings\DVZalagaev\Desktop\test.xls")
Set mysheet = MyWo.Worksheets( 1 )


Set MyRst = New ADODB.Recordset


MyRst.Open "q8_staffing_2", CurrentProject.Connection


    mysheet.Range("A1:F3000").Selection.ClearContents


ct =  2 
mysheet.Cells( 1 ,  1 ) = "Staff List: General report"


Do Until MyRst.EOF
            mysheet.Cells(ct,  1 ) = MyRst![staff_list_id]
            mysheet.Cells(ct,  2 ) = MyRst![FM_title]
            mysheet.Cells(ct,  3 ) = MyRst![job_title]
            mysheet.Cells(ct,  4 ) = CDate(MyRst![DatePositionStarted])
            mysheet.Cells(ct,  5 ) = CDate(MyRst![DatePositionRemoved])
            mysheet.Cells(ct,  6 ) = MyRst![Location_eng]
            ct = ct +  1 
            MyRst.MoveNext
Loop
MsgBox (ct & " records were uploaded from DB into XLS file")
'++++++++++++++++++++++++

    


MyRst.Close
Set MyRst = Nothing

MyWo.Save
Set mysheet = Nothing
MyWo.Close
Set MyWo = Nothing

myOlApp.Quit
Set mysheet = Nothing
Set myOlApp = Nothing





Exit_btn_exp1_Click:
    Exit Sub

Err_btn_exp1_Click:
    MsgBox err.Description
    
    Resume Exit_btn_exp1_Click
exit1:

End Sub

MyWo.Close SaveChanges:=True