Not able to pull records from access to excel, Pro

Question

I using the below code to pull records from access to excel. I am getting error at

connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB

The error says"invalid sql statement, delete, insert,procedure,selet or update"

Kindly help as I am stuck and cannot move forward at all....

please help.

Sub automateAccessADO_9() 'Using ADO to Import data from an Access Database Table to an Excel worksheet (your host application). 'refer Image 9a to view the existing SalesManager Table in MS Access file "SalesReport.accdb".

'To use ADO in your VBA project, you must add a reference to the ADO Object Library in Excel (your host application) by clicking Tools-References in VBE, and then choose an appropriate version of Microsoft ActiveX Data Objects x.x Library from the list.

'--------------
'DIM STATEMENTS

Dim strMyPath As String, strDBName As String, strDB As String, strSQL As String
Dim i As Long, n As Long, lFieldCount As Long
Dim rng As Range

'instantiate an ADO object using Dim with the New keyword:
Dim adoRecSet As New ADODB.Recordset
Dim connDB As New ADODB.Connection

'--------------
'THE CONNECTION OBJECT

strDBName = "Computer.accdb"
strMyPath = ThisWorkbook.Path
strDB = strMyPath & "\" & strDBName

'Connect to a data source:
'For pre - MS Access 2007, .mdb files (viz. MS Access 97 up to MS Access 2003), use the Jet provider: "Microsoft.Jet.OLEDB.4.0". For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0". The ACE Provider can be used for both the Access .mdb & .accdb files.
connDB.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB

'--------------
'OPEN RECORDSET, ACCESS RECORDS AND FIELDS

Dim ws As Worksheet
'set the worksheet:
Set ws = ActiveWorkbook.Sheets("Sheet1")

'Set the ADO Recordset object:
Set adoRecSet = New ADODB.Recordset

'Opening the table named SalesManager:
strTable = "memory"

'--------------
'COPY RECORDS FROM ALL FIELDS OF A RECORDSET:
'refer Image 9d to view records copied to Excel worksheet

adoRecSet.Open Source:=strTable, ActiveConnection:=connDB, CursorType:=adOpenStatic, LockType:=adLockOptimistic

Set rng = ws.Range("A1")
lFieldCount = adoRecSet.Fields.Count

For i = 0 To lFieldCount - 1
'copy column names in first row of the worksheet:
rng.Offset(0, i).Value = adoRecSet.Fields(i).Name
adoRecSet.MoveFirst

'copy record values starting from second row of the worksheet:
n = 1
Do While Not adoRecSet.EOF
rng.Offset(n, i).Value = adoRecSet.Fields(i).Value
adoRecSet.MoveNext
n = n + 1
Loop

Next i

'select column range to AutoFit column width:
Range(ws.Columns(1), ws.Columns(lFieldCount)).AutoFit
'worksheet columns are deleted because this code is only for demo:
Range(ws.Columns(1), ws.Columns(lFieldCount)).Delete
adoRecSet.Close

'close the objects
connDB.Close

'destroy the variables
Set adoRecSet = Nothing
Set connDB = Nothing

End Sub 

Answer 1

When going from Access to Excel, you have quite a few options!

Here's one way to EXPORT data from Access to Excel.

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
 Dim rst As DAO.Recordset
 Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

 blnEXCEL = False

' Replace True with False if you do not want the first row of
 ' the worksheet to be a header row (the names of the fields
 ' from the recordset)
 blnHeaderRow = True

' Establish an EXCEL application object
 On Error Resume Next
 Set xlx = GetObject(, "Excel.Application")
 If Err.Number <> 0 Then
       Set xlx = CreateObject("Excel.Application")
       blnEXCEL = True
 End If
 Err.Clear
 On Error GoTo 0

' Change True to False if you do not want the workbook to be
 ' visible when the code is running
 xlx.Visible = True

' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls")

' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
Set xls = xlw.Worksheets("WorksheetName")

' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)

If rst.EOF = False And rst.BOF = False Then

      rst.MoveFirst

      If blnHeaderRow = True Then
             For lngColumn = 0 To rst.Fields.Count - 1
                   xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
             Next lngColumn 
             Set xlc = xlc.Offset(1,0)
       End If

      ' write data to worksheet
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1,0)
      Loop

End If

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

' Close the EXCEL file while saving the file, and clean up the EXCEL objects
 Set xlc = Nothing
 Set xls = Nothing
 xlw.Close True   ' close the EXCEL file and save the new data
 Set xlw = Nothing
 If blnEXCEL = True Then xlx.Quit
 Set xlx = Nothing

Here's another way.

Dim lngColumn As Long
 Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
 Dim dbs As DAO.Database
 Dim rst As DAO.Recordset
 Dim strPathFileName As String, strWorksheetName As String
 Dim strRecordsetDataSource As String
 Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

 blnEXCEL = False

' Replace C:\Filename.xls with the actual path and filename
 ' that will be used to save the new EXCEL file into which you 
 ' will write the data
 strPathFileName = "C:\Filename.xls"

' Replace QueryOrTableName with the real name of the table or query
 ' whose data are to be written into the worksheet
 strRecordsetDataSource = "QueryOrTableName"

' Replace True with False if you do not want the first row of
 ' the worksheet to be a header row (the names of the fields
 ' from the recordset)
 blnHeaderRow = True

' Establish an EXCEL application object
 On Error Resume Next
 Set xlx = GetObject(, "Excel.Application")
 If Err.Number <> 0 Then
       Set xlx = CreateObject("Excel.Application")
       blnEXCEL = True
 End If
 Err.Clear
 On Error GoTo 0

' Change True to False if you do not want the workbook to be
 ' visible when the code is running
 xlx.Visible = True

' Create a new EXCEL workbook
 Set xlw = xlx.Workbooks.Add

' Rename the first worksheet in the EXCEL file to be the first 31 
 ' characters of the string in the strRecordsetDataSource variable
 Set xls = xlw.Worksheets(1)
 xls.Name = Trim(Left(strRecordsetDataSource, 31))

' Replace A1 with the cell reference of the first cell into which the 
 ' headers will be written (blnHeaderRow = True), or into which the data 
 ' values will be written (blnHeaderRow = False)
 Set xlc = xls.Range("A1")

 Set dbs = CurrentDb()

 Set rst = dbs.OpenRecordset(strRecordsetDataSource, dbOpenDynaset, dbReadOnly)

 If rst.EOF = False And rst.BOF = False Then
       ' Write the header row to worksheet
       If blnHeaderRow = True Then
             For lngColumn = 0 To rst.Fields.Count - 1
                   xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
             Next lngColumn
             Set xlc = xlc.Offset(1,0)
       End If

       ' copy the recordset's data to worksheet
       xlc.CopyFromRecordset rst
 End If

 rst.Close
 Set rst = Nothing
 dbs.Close
 Set dbs = Nothing

' Save and close the EXCEL file, and clean up the EXCEL objects
 Set xlc = Nothing
 Set xls = Nothing
 xlw.SaveAs strPathFileName
 xlw.Close False
 Set xlw = Nothing
 If blnEXCEL = True Then xlx.Quit
 Set xlx = Nothing

Here's a way to IMPORT date from Access to Excel.

Sub ADOImportFromAccessTable(DBFullName As String, _
    TableName As String, TargetRange As Range)
' Example: ADOImportFromAccessTable "C:\FolderName\DataBaseName.mdb", _
    "TableName", Range("C1")
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
    Set TargetRange = TargetRange.Cells(1, 1)
    ' open the database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
        DBFullName & ";"
    Set rs = New ADODB.Recordset
    With rs
        ' open the recordset
        .Open TableName, cn, adOpenStatic, adLockOptimistic, adCmdTable 
        ' all records
        '.Open "SELECT * FROM " & TableName & _
            " WHERE [FieldName] = 'MyCriteria'", cn, , , adCmdText 
        ' filter records

        RS2WS rs, TargetRange ' write data from the recordset to the worksheet

'        ' optional approach for Excel 2000 or later (RS2WS is not necessary)
'        For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
'            TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
'        Next
'        TargetRange.Offset(1, 0).CopyFromRecordset rs ' the recordset data

    End With
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Here's one more way to IMPORT your data.

Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
    FieldName As String, TargetRange As Range)
' Example: DAOCopyFromRecordSet "C:\FolderName\DataBaseName.mdb", _
    "TableName", "FieldName", Range("C1")
Dim db As Database, rs As Recordset
Dim intColIndex As Integer
    Set TargetRange = TargetRange.Cells(1, 1)
    Set db = OpenDatabase(DBFullName)
    Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
    'Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
        " WHERE " & FieldName & _
        " = 'MyCriteria'", dbReadOnly) ' filter records
    ' write field names
    For intColIndex = 0 To rs.Fields.Count - 1
        TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
    Next
    ' write recordset
    TargetRange.Offset(1, 0).CopyFromRecordset rs
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub