Excel as Datasource using VBA

[seageath]

Dear Gurus,

I have following code to use other excel as data source, but seems the code didn't catch the value from the excel sheet. Please help to advice. Thank you very much.

Sub Excel_ADO()

    Dim cN As ADODB.Connection '* Connection String
    Dim RS As ADODB.Recordset '* Record Set
    Dim sQuery As String '* Query String
    Dim i1 As Long
    Dim lMaxRow As Long '* Last Row in the Sheet
    Dim iRevCol As Integer '*
    Dim i3 As Integer
    
    On Error GoTo ADO_ERROR
    
    Set cN = New ADODB.Connection
    cN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\seageath\Documents\DBConn\Current Code List.xls;Extended Properties=Excel 8.0;Persist Security Info=False"
    cN.ConnectionTimeout = 40
    cN.Open
    
    Set RS = New ADODB.Recordset
    
    lMaxRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    iRevCol = 2
    
    For i1 = 2 To lMaxRow
    
        Application.StatusBar = i1
        strQuery = "SELECT * FROM [Sheet1$A" & i1 & ":B" & i1 & "]"
        
        RS.ActiveConnection = cN
        RS.Source = strQuery
        RS.Open
        
        If RS.EOF = True And RS.BOF = True Then
            GoTo TakeNextRecord
        End If
        
        RS.MoveFirst
        Do Until RS.EOF = True
            sName = Trim$(RS("Name").Value)
            sAge = Trim$(RS("Age").Value)
            ' Do some operations
            RS.MoveNext
        Loop
        
        
TakeNextRecord:
        If RS.State <> adStateClosed Then
        RS.Close
        End If
    Next i1
    
    If Not RS Is Nothing Then Set RS = Nothing
    If Not cN Is Nothing Then Set cN = Nothing
    
ADO_ERROR:
    If Err <> 0 Then
        Debug.Assert Err = 0
        MsgBox Err.Description
        Resume Next
    End If

End Sub

The data in the Current Code List.xls are

A B
1 Name Age
2 Max 6
3 Elmo 10
4 Oni 17

Thanks for the help

 

[xenou]

Rewritten slightly (sorry old habits). Works fine. Your code looks a little awkward as you should not open a recordset on every iteration of the loop. Open the recordset first, then iterate the *recordset* row by row. Also, you don't need to get a last row value - the recordset will keep track of its rows.

When using ADO on worksheets I would either always make sure that the XL file is simple data in a plain grid, or else use a named range as the data source (or both).

Also, with ADO and .xls Excel data sources there is known to be problems unless the Excel file is *closed*. Avoid querying open .xls workbooks with ADO.

[COLOR="Navy"]Sub[/COLOR] Excel_ADO()
[COLOR="Navy"]Dim[/COLOR] cn [COLOR="Navy"]As[/COLOR] ADODB.Connection [COLOR="SeaGreen"]'* Connection String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] rs [COLOR="Navy"]As[/COLOR] ADODB.Recordset [COLOR="SeaGreen"]'* Record Set[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sQuery [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR] [COLOR="SeaGreen"]'* Query String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sConn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sName [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sAge [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

    [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]GoTo[/COLOR] ADO_ERROR
    
    [COLOR="SeaGreen"]'//Connection String[/COLOR]
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;"
    sConn = sConn & "Data Source=C:\Users\seageath\Documents\DBConn\Current Code List.xls;"
    sConn = sConn & "Extended Properties=Excel 8.0;Persist Security Info=False"
    
    [COLOR="SeaGreen"]'//SQL Command Text[/COLOR]
    sQuery = "SELECT * FROM [Sheet1$]"
    
    [COLOR="SeaGreen"]'//ADO Objects[/COLOR]
    [COLOR="Navy"]Set[/COLOR] cn = [COLOR="Navy"]New[/COLOR] ADODB.Connection
    [COLOR="Navy"]Set[/COLOR] rs = [COLOR="Navy"]New[/COLOR] ADODB.Recordset
    cn.Open sConn

    [COLOR="SeaGreen"]'//Go[/COLOR]
    [COLOR="Navy"]With[/COLOR] rs
        .ActiveConnection = cn
        .Source = sQuery
        .Open
        [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] rs.EOF [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] [COLOR="Navy"]Not[/COLOR] rs.EOF
                sName = Trim$(rs("Name").Value)
                sAge = Trim$(rs("Age").Value)
                [COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR] sName & "|" & sAge
                rs.MoveNext
            [COLOR="Navy"]Loop[/COLOR]
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        rs.Close
        [COLOR="Navy"]Set[/COLOR] rs = [COLOR="Navy"]Nothing[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]

My_Exit:
[COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] rs [COLOR="Navy"]Is[/COLOR] [COLOR="Navy"]Nothing[/COLOR] [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] rs.State = adStateOpen [COLOR="Navy"]Then[/COLOR]
        rs.Close
        [COLOR="Navy"]Set[/COLOR] rs = [COLOR="Navy"]Nothing[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] cn [COLOR="Navy"]Is[/COLOR] [COLOR="Navy"]Nothing[/COLOR] [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] cn.State = adStateOpen [COLOR="Navy"]Then[/COLOR]
        cn.Close
        [COLOR="Navy"]Set[/COLOR] cn = [COLOR="Navy"]Nothing[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]

ADO_ERROR:
MsgBox Err.Description
[COLOR="Navy"]Resume[/COLOR] My_Exit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]