Recordset is showing as empty But Query wizard Returns Records

[svuyyuru]

I'm trying to write record set contents to excel. My query runs perfect in access query wizard, but recordset showing as null. My VBA code

    Dim cnn As ADODB.Connection
    Dim recordst As ADODB.Recordset
    Dim strSQL As String
    Dim strPath As String
    Dim appXL As Excel.Application
    Dim wb As Excel.Workbook
    Dim wsSheet1 As Excel.Worksheet
    Dim i As Long
    
    Set cnn = CurrentProject.Connection
    Set recordst = New ADODB.Recordset
    Set appXL = CreateObject("Excel.Application")
    With appXL
         Set wb = .Workbooks.Open("C:\temp\sample.xls") '
        .Visible = True
    End With
    strSQL = "SELECT * FROM table1"
      Debug.Print strSQL
      recordst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic,   
     adCmdTableDirect
    Set wsSheet1 = wb.Sheets(conSHT_NAME)
    wsSheet1.Cells.ClearContents
    wsSheet1.Select
    For i = 1 To recordst.Fields.Count
         wsSheet1.Cells(1, i) = recordst.Fields(i - 1).Name
    Next i
    If recordst.EOF Then
    MsgBox "Recordset is null"
    End If

    wsSheet1.Range("A2").CopyFromRecordset recordst
    wsSheet1.Columns("A:Q").EntireColumn.AutoFit
    rst.Close

 

[pr2-eugin]

Any reason for the choice of ADO over DAO?

 

[svuyyuru]

Not specific reason. Is the problem with ADO or DAO?

 

[pr2-eugin]

DAO is the Native Object for Access. So it is better to use it.

    Dim rsObj As DAO.Recordset
    Dim strSQL As String
    Dim strPath As String
    Dim appXL As Excel.Application
    Dim wb As Excel.Workbook
    Dim wsSheet1 As Excel.Worksheet
    Dim i As Long
    
    Set appXL = CreateObject("Excel.Application")
    With appXL
        Set wb = .Workbooks.Open("C:\temp\sample.xls") '
        .Visible = True
    End With
    
    Set wsSheet1 = wb.Sheets(conSHT_NAME)    [COLOR=Green]'Where has this conSHT_NAME been defined?[/COLOR]
    wsSheet1.Cells.ClearContents
    wsSheet1.Select
    
    strSQL = "SELECT * FROM table1"
    Set rsObj = CurrentDB.OpenRecordset(strSQL)
    
    For i = 1 To rsObj.Fields.Count
        wsSheet1.Cells(1, i) = rsObj.Fields(i - 1).Name
    Next
    
    If rsObj.Recordcount <> 0 Then
        wsSheet1.Range("A2").CopyFromRecordset rsObj
        wsSheet1.Columns("A:Q").EntireColumn.AutoFit
    Else
        MsgBox "Recordset is null"
    End If
    rsObj.Close

 

[svuyyuru]

Cool........Works Perfect. Thank you so much.

 

[pr2-eugin]

You're welcome ! Good Luck !