Connect and get data from microsoft access database in excel using vba

Option Explicit

Sub ExportDataToAccess()

    Dim ConnObj As ADODB.Connection
    Dim RecSet As ADODB.Recordset
    Dim ConnCmd As ADODB.Command
    Dim ColNames As ADODB.Fields
    Dim DataSource As String
    Dim intLoop As Integer
   
    'Define the data source
    DataSource = "C:\Users\sourav\Desktop\A732CreatingForms_1.accdb"

    'Create a new connection object & a new command object
    Set ConnObj = New ADODB.Connection
    Set ConnCmd = New ADODB.Command

    'Create a new connection
    With ConnObj
        .Provider = "Microsoft.ACE.OLEDB.12.0"    'For *.ACCDB Databases
        .ConnectionString = DataSource
        .Open
    End With
   
    'This will allow the command object to use the Active Connection
    ConnCmd.ActiveConnection = ConnObj

    'Define the Query String & the Query Type.
    ConnCmd.CommandText = "SELECT * from Employees;"
    ConnCmd.CommandType = adCmdText

    'Exectue the Query & Get the column Names.
    Set RecSet = ConnCmd.Execute
    Set ColNames = RecSet.Fields
   
    'Populate the header row of the Excel Sheet.
    For intLoop = 0 To ColNames.Count - 1
        Cells(1, intLoop + 1).Value = ColNames.Item(intLoop).Name
    Next
   
    'Dump the data in the worksheet.
    Range("A2").CopyFromRecordset RecSet
   
    'Close the Connection
    ConnObj.Close

End Sub

Connect to access database ,run query and fetch the result in excel using VBA,VBA Teacher Sourav,Kolkata 09748184075

Sub getDataFromAccess()
' Click on Tools, References and select
' the Microsoft ActiveX Data Objects 2.0 Library

Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer

Cells.Clear

' Database path info

' Your path will be different
DBFullName = "C:\Users\sourav\Desktop\Database6.accdb"
' Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect

' Create RecordSet
Set Recordset = New ADODB.Recordset
With Recordset
' Filter Data
Source = "SELECT * FROM QWERTY"
'Source = "SELECT * FROM Customers WHERE [Job Title] = 'Owner' "
.Open Source:=Source, ActiveConnection:=Connection

' MsgBox “The Query:” & vbNewLine & vbNewLine & Source

' Write field names

For Col = 0 To (Recordset.Fields.Count - 1)


Range("A1").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next

' Write recordset
Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub