• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Will copy the information from access to ms excel according to the recordset u specify....!!!!! You

Will copy the information from access to ms excel according to the recordset u specify....!!!!! You

Will copy the information from access to ms excel according to the recordset u specify....!!!!! You can define ur recordset as per your

API Declarations


Dim rs As New ADODB.Recordset
' copy the below mentioned the code in the CLICK EVENT OF COMMAND BUTTON



Rate Will copy the information from access to ms excel according to the recordset u specify....!!!!! You

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Dim query As String
Dim excel_app As Object
Dim excel_sheet As Object
Dim row As Long
Dim statement As String
Dim col As Integer
    DoEvents
    Set excel_app = CreateObject("Excel.Application")
    excel_app.Visible = True
    excel_app.workbooks.Add
      If Val(excel_app.Application.Version) >= 8 Then
         Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If
    Set objconn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    Set objcmd = CreateObject("ADODB.Command")
    objconn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
    App.Path & "\sample.mdb;Persist Security Info = False "    objcmd.CommandType = adCmdText
query="select * from tablename" 'HERE CHANGE UR QUERY ACCORDINGLY
rs.Open (query), objconn, adOpenDynamic, adLockOptimistic
    For col = 0 To rs.Fields.Count - 1
        excel_sheet.Cells(1, col + 1) = rs.Fields(col).Name
    Next col
    row = 2
    Do While Not rs.EOF
      For col = 0 To rs.Fields.Count - 1
         excel_sheet.Cells(row, col + 1) = _
         rs.Fields(col).Value
      Next col
        row = row + 1
        rs.MoveNext
    Loop
        excel_sheet.Range( _
        excel_sheet.Cells(1, 1), _
        excel_sheet.Cells(1, _
        rs.Fields.Count)).Columns.AutoFit
    rs.Close
    Set rs = Nothing
    objconn.Close
    Set objconn = Nothing
    excel_sheet.rows(1).Font.Bold = True
    excel_sheet.rows(2).Select
    excel_app.ActiveWindow.FreezePanes = True
    excel_sheet.Cells(1, 1).Select
    excel_app.ActiveWorkbook.Close
    excel_app.Quit
    Set excel_sheet = Nothing
    Set excel_app = Nothing
    Screen.MousePointer = vbDefault
    MsgBox "Copied " & Format$(row - 2) & " values."
End Sub