Loop through recordset - Copy required Field

     

    Sub Copy_Required_Field_from_Recordset()
    Dim cn As ADODB.Connection
    Set cn = CurrentProject.Connection
    Dim rs As New ADODB.RecordSet
    rs.ActiveConnection = cn
    'To open Employees Table
    rs.Open "Select * from Employees"
    Dim Ex As Excel.Application
    Set Ex = CreateObject("Excel.Application")
    Ex.Visible = True
    Dim wkb As Excel.Workbook
    Set wkb = Workbooks.Add
    wkb.Windows(1).Visible = True
    Dim sh As Worksheet
    Set sh = wkb.Sheets("Sheet1")
    i = 1
    Do Until rs.EOF
    sh.Cells(i, 3).Value = rs.Fields("Emp_Name")
    rs.MoveNext
    i = i + 1
    Loop
    rs.Close
    Set rs = Nothing
    End Sub

    Download the File