Refresh ADODB Recordset

[oteixeira]

Hello to all.
I’m trying to use Excel 2007 to extract data from an Access 2007 database using ADODB. I know how to connect to the database. What I’m trying to achieve is to write the SQL query with parameters (using the worksheet cells) and then write a user defined function to refresh the recordset.
Does anyone have a piece of code to share where I can learn the basics to get this?
Thanks in advance for any kind help.
Octavio.

[Kyle123]

Hi,

Can you post the code that you already have and I'll adapt it to make it a bit more dynamic

[oteixeira]

Thanks for answering. Well, at this time i don't have much more than the conenction and the query. I'm not sure if i can refer to the parameters as "?"
Thank you

Public Sub executar()
    If ligado Then
        Dim query1 As String
        Dim rs1 As ADODB.Recordset
        Dim param1 As ADODB.Parameter
        Dim param2 As ADODB.Parameter
        Set cn = New ADODB.Connection
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\boxus\Geral\Dados\UTLT.accdb;Persist Security Info = False"
        query1 = "SELECT VALOR FROM BK_EXTRACTOS_LINHAS WHERE EXT_ID = ? AND NUMLINHA = ?"
    End If
End Sub

[Kyle123]

see if this answers your questions:

Public Sub executar(arg1 As Long, arg2 As Long)
    If ligado Then
        Dim query1 As String
        Dim rs1 As ADODB.Recordset

        Set cn = New ADODB.Connection
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\boxus\Geral\Dados\UTLT.accdb;Persist Security Info = False"
        
        query1 = "SELECT VALOR FROM BK_EXTRACTOS_LINHAS WHERE EXT_ID = " & arg1 & " AND NUMLINHA = " & arg2 & ";"
                
        Set rs1 = New ADODB.Recordset
                
        rs1.Open query1, cn, adOpenStatic
        
        With Sheet1.Cells(1, 1)
            .CurrentRegion.ClearContents
            .Cells(1, 1).CopyFromRecordset rs1
        End With
        
        
    End If
End Sub

Sub updatedata()

executar 123456, 123456


End Sub

It will dump the results in Sheet1, starting at A1

[oteixeira]

Thank you again for you kind help. This is not exactly what i'm looking for but gives me some clues. I wrote a lot of code to get out data from an oracle database but I'm struggling whith Access. Will it be possible to use input and output parameters with Access. Just let me show the code for oracle, perhaps you know to do it with Access:

To get the data:

If ConnectStat Then
    Dim qry1 As String
    Dim qry2 As String
    
    qry1 = "BEGIN SELECT max(l.description) INTO :desc_deb FROM gl_je_lines l, gl_code_combinations cc WHERE cc.code_combination_id = l.code_combination_id AND l.accounted_dr = :debito AND cc.code_combination_id = 127123 AND l.set_of_books_id = 53 end;"
    OraDatabase.Parameters.Add "debito", 0, ORAPARM_INPUT
    OraDatabase.Parameters.Add "desc_deb", 0, ORAPARM_OUTPUT
    Set DescDebSet = OraDatabase.CreateSql(qry1, ORASQL_FAILEXEC)
End If
End Sub

The function that puts the data into the cell:

Public Function Descr_Deb(ValorDeb As String) As Variant
    If ConnectStat Then
        OraDatabase.Parameters("debito").Value = ValorDeb
        DescDebSet.Refresh
                Descr_Deb = OraDatabase.Parameters("desc_deb")
                End If
End Function

Sorry to bother you with this but it will be great if i could achieve this using ADODB and Access.

Octavio

[Kyle123]

Ah got you now, I understand, unfortunately as far as I know output parameters are not supported in Access

[oteixeira]

I think ADODB supports output parameters, because you can define:

Dim param1 As ADODB.Parameter
                With param1
            .Direction = adParamOutput
        End With

Now, in the SELECT statement how can i, if possible, use the INTO clause?

Thanks again.

Octavio

[Kyle123]

ADODB can, but it can interact with SQL server, I don't think the access database engine can however

[oteixeira]

Ok Kyle, thanks a lot for your help, anyway.

Octavio

[JohnM3]

Hi OT

I will need 3 posts for this lenght issue . This is post 1 of 3
Copy and paste the code in new WB. Create Blank Access DB and put
in same Dir as WB, Call DB MyDB.accdb.

Code tested and works with 2007 and shd work with 2003 and prior as Provider
is the only real change.

There is only 1 subroutine called Sub Main

It will:
create table
insert records
create stored procs
create ADO params
write recs to sheet1

WARNING:
Every other time the Sub runs it will DELETE table and immediately exit sub. By design.
Lets you tinker with CreateTable / Inserts / and modify Stored Procs
Stored Procs only created once. You must manually delete if u need to. If you change the
table you must change the StoredProc definitions. There are 3 stored proc - TEXT - DATE - DECIMAL.
Refer to links for deeper think.

hth
regards
John

Post 1 of 3

Option Explicit

' Excel 2007 calling --> Access2007
' Create Table
' Create Stored Procs (3)
' Use ADO Params to get specifc records
' Privates s/b Properties - but not done here
' No error checking - point and shoot

' By Design
' Every OTHER TIME sub main runs it will DELETE TABLE AND EXIT  and NOT goto
' end of procedure. This so you can tinker with create table and create procs

'------------------------
'   ADO Normal Objects
'------------------------
Private mo_cn As ADODB.Connection
Private mo_rs As ADODB.Recordset
Private mo_cmd As ADODB.Command

'------------------------
'   ADO Parameters
'------------------------
Private mo_param_LastName As ADODB.Parameter
Private mo_param_Date As ADODB.Parameter
Private mo_param_Salary As ADODB.Parameter

'------------------------
'   ADO Properties
'------------------------
Private ms_Provider As String
Private ms_ProviderProperty As String
Private ms_DataSource As String
Private ms_AccessFileName As String
Private ms_ConnString As String

'------------------------
'   Sql
'------------------------
Private ms_SQLDropTable As String

'------------------------
'   Sql
'------------------------
Private ms_SQLInsertRecord As String

'------------------------
'   Sql
'------------------------
Private ms_SQLCreateView As String

'------------------------
'   Stored Procs exist
'------------------------
Private mb_ExistsStoredProcLastName As Boolean
Private mb_ExistsStoredProcHireDate As Boolean
Private mb_ExistsStoredProcSalary As Boolean

'------------------------
'   Record Values for Insert
'------------------------
Private mv_LastName As Variant
Private mv_FirstName As Variant
Private mv_HireDate As Variant
Private mv_Salary As Variant
Private mv_Bonus As Variant
Private mv_Miles As Variant
Private mv_Active As Variant

'------------------------
'   Misc
'------------------------
Private ms_ct As String
Private ms_fld As String
Private ms_v As String
Private ms_ActiveCommand As String
Private mb_TableExists As Boolean
Private mb_InsertRecords As Boolean
Private mb_ExitSub As Boolean
Private mlng_RecCNT As Long
Private ms_Tmp As String
Private mi_Case As Integer

Public Sub Main()
    
    'http://www.excelforum.com/excel-programming/803683-refresh-adodb-recordset.html
    
    '-----------------
    '   Required
    '   MS ACCESS 2007 or (guessing) MS ACCESS 2003/2
    '-----------------
    '   This Sub
    '-----------------
    '   Creates Table TestTable
    '   Drops Table TestTable if it exists and EXITS SUB
    '
    '   Inserts 10 records into TestTable
    '   Inserts 3 "Stored Procedures" into Access if NOT EXIST
    '
    '   Uses ADO Parameters to retreive data
    '   Write recordset to sheet
    '
    '   Stored Procs only created once
    '   Table created over and over so you can play with
    '
    '-----------------
    
    '-----------------------------------------
    '   Database Name:  MyDB.accdb
    '   Table Name:     TestTable
    '   Location:       Same Directory as EXCEL WB
    '-----------------------------------------
    
    On Error GoTo EH_Main
    
    Const CON_TARGET_TABLE As String = "TestTable"
    Const CON_STORED_PROC_LASTNAME As String = "procLastName"
    Const CON_STORED_PROC_HIREDATE As String = "procHireDate"
    Const CON_STORED_PROC_SALARY As String = "procSalary"
    
    Dim i As Integer
    Dim lng As Long

[JohnM3]

Post 2 of 3

    '-----------------
    '   Initialize
    '-----------------
    mb_TableExists = False
    mb_ExistsStoredProcLastName = False
    mb_ExistsStoredProcHireDate = False
    mb_ExistsStoredProcSalary = False
    mb_ExitSub = False
    
    '-----------------
    '   Connection Properties
    '   http://www.connectionstrings.com/access-2007
    '   http://www.connectionstrings.com/access
    '-----------------
    If CDbl(Application.Version) >= 12 Then
        ms_ProviderProperty = "Microsoft.ACE.OLEDB.12.0"
        ms_Provider = "Provider=Microsoft.ACE.OLEDB.12.0;"  ' Not Used
        ms_AccessFileName = "MyDB.accdb"                    '<------- Change
    Else
        ms_ProviderProperty = "Microsoft.Jet.OLEDB.4.0"
        ms_Provider = "Provider=Microsoft.Jet.OLEDB.4.0;"   ' Not Used
        ms_AccessFileName = "MyDB.mdb"                      '<------- Change
    End If
    
    '-----------------
    '   Connection Properties
    '-----------------
    ms_DataSource = ThisWorkbook.Path & "\" & ms_AccessFileName
    ms_ConnString = ms_Provider & ms_DataSource              'Not Used
    
    '-----------------
    '   File Check
    '-----------------
    ms_Tmp = Dir(ms_DataSource, vbDirectory)
    If Len(ms_Tmp) < 1 Then
        MsgBox "Can't find file ... terminating.", vbCritical, "Public Sub Main()"
        Exit Sub
    End If
    
    '-----------------
    '   Create Table
    '-----------------
    '   http://allenbrowne.com/func-DDL.html
    '-----------------
    ms_ct = "Create Table " & CON_TARGET_TABLE
    ms_ct = ms_ct & "("
    ms_ct = ms_ct & "[LastName] Text(50),"
    ms_ct = ms_ct & "[FirstName] Text(50),"
    ms_ct = ms_ct & "[HireDate] Date,"
    ms_ct = ms_ct & "[Salary] Decimal(6), "
    ms_ct = ms_ct & "[Bonus] Currency, "
    ms_ct = ms_ct & "[TravelMiles] Double, "
    ms_ct = ms_ct & "[ActiveEmp] YesNo "
    ms_ct = ms_ct & ")"
    
    '-----------------
    '   Drop Table SQL
    '-----------------
    ms_SQLDropTable = "Drop table " & CON_TARGET_TABLE
    
    '-----------------
    '   Make Connection
    '-----------------
    Set mo_cn = Nothing
    Set mo_cn = New ADODB.Connection
    With mo_cn
       .Provider = ms_ProviderProperty
       .ConnectionString = ms_DataSource
       .Open
       If 1 = 2 Then
        .Close
       End If
    End With
    
    '-----------------
    '   Get List of Tables
    '   http://support.microsoft.com/kb/186246
    '-----------------
    Set mo_rs = Nothing
    Set mo_rs = New ADODB.Recordset
    Set mo_rs = mo_cn.OpenSchema(adSchemaTables)
    While Not mo_rs.EOF
        'Debug.Print mo_rs!TABLE_NAME
        If UCase(mo_rs!TABLE_NAME) = UCase(CON_TARGET_TABLE) Then
            '-----------------
            '   Sets up Kill Table and Exit Sub w/o completing Sub Main
            '-----------------
            mb_TableExists = True
            mb_ExitSub = True
        End If
        mo_rs.MoveNext
    Wend
    
    '-----------------
    '   Get List of Views (Stored Procedures)
    '   http://support.microsoft.com/kb/186246
    '-----------------
    Set mo_rs = Nothing
    Set mo_rs = New ADODB.Recordset
    Set mo_rs = mo_cn.OpenSchema(adSchemaProcedures)
    While Not mo_rs.EOF
        'Debug.Print mo_rs!PROCEDURE_NAME
        If UCase(mo_rs!PROCEDURE_NAME) = UCase(CON_STORED_PROC_LASTNAME) Then
            'Stored Proc created when this var is TRUE
            mb_ExistsStoredProcLastName = True
        End If
        If UCase(mo_rs!PROCEDURE_NAME) = UCase(CON_STORED_PROC_HIREDATE) Then
            'Stored Proc created when this var is TRUE
            mb_ExistsStoredProcHireDate = True
        End If
        If UCase(mo_rs!PROCEDURE_NAME) = UCase(CON_STORED_PROC_SALARY) Then
            'Stored Proc created when this var is TRUE
            mb_ExistsStoredProcSalary = True
        End If
        mo_rs.MoveNext
    Wend
    
    '-----------------
    '   Decision
    '   Drop Table and Exit -or- Continue
    '-----------------
    Select Case mb_TableExists
        Case True:
            ms_ActiveCommand = ms_SQLDropTable ' Kill Table and EXIT
            mb_InsertRecords = False
        Case False:
            ms_ActiveCommand = ms_ct 'Create Testtable and continue
            mb_InsertRecords = True
    End Select
    
    '-----------------
    '   Command Object
    '   ms_ActiveCommand (See above)
    '-----------------
    Set mo_cmd = Nothing
    Set mo_cmd = New ADODB.Command
    With mo_cmd
        .ActiveConnection = mo_cn
        .CommandText = ms_ActiveCommand
        .Execute
    End With

    '-----------------
    '   Bad way to Exit nevertheless ....
    '-----------------
    If mb_ExitSub Then
        Set mo_rs = Nothing
        Set mo_cn = Nothing
        Set mo_cmd = Nothing
        Exit Sub
    End If

    '-----------------
    '   Values for 10 Records
    '-----------------
    mlng_RecCNT = 10
    If mb_InsertRecords Then
        mv_LastName = Array("Brown", "Brown", "Brown", "Smith", "Manning", "Manning", "Geithner", "Thomas", "Edwards", "Benton")
        mv_FirstName = Array("Fred", "John", "Alice", "Alice", "Eli", "Peyton", "Tim", "Frank", "Tom", "Susan")
        mv_HireDate = Array("1/1/2001", "2/1/2002", "3/1/2003", "4/1/2004", "5/1/2005", "6/1/2006", "7/1/2007", "8/1/2008", "9/1/2009", "10/1/2010")
        mv_Salary = Array(15000, 25000, 35000, 45000, 55000, 65000, 75000, 85000, 95000, 100000)
        mv_Bonus = Array(150.1, 250.2, 350.3, 450.4, 550.5, 650.6, 750.7, 850.8, 950.9, 1000.25)
        mv_Miles = Array(1500, 2500, 3500, 4500, 5500, 6500, 7500, 8500, 9500, 10000)
        mv_Active = Array(True, True, True, True, False, True, True, False, True, True)
    End If

    '-----------------
    '   Insert Records
    '-----------------
    '   Part 1 - Field Names
    '-----------------
    ms_fld = vbNullString
    If mb_InsertRecords Then
        ms_fld = "INSERT INTO [TestTable] "
        ms_fld = ms_fld & "("
        ms_fld = ms_fld & " [LastName],"
        ms_fld = ms_fld & " [FirstName],"
        ms_fld = ms_fld & " [HireDate],"
        ms_fld = ms_fld & " [Salary],"
        ms_fld = ms_fld & " [Bonus],"
        ms_fld = ms_fld & " [TravelMiles],"
        ms_fld = ms_fld & " [ActiveEmp] "
        ms_fld = ms_fld & ")"
        ms_fld = ms_fld & " VALUES "
    End If
        
    '-----------------
    '   Insert Records
    '-----------------
    '   Part 2 - Field Values
    '-----------------
    For lng = 0 To mlng_RecCNT - 1
        ms_v = vbNullString
        ms_v = ms_v & "( "
        ms_v = ms_v & "'" & mv_LastName(lng) & "'" & ", "
        ms_v = ms_v & "'" & mv_FirstName(lng) & "'" & ", "
        ms_v = ms_v & "#" & mv_HireDate(lng) & "#" & ", "
        ms_v = ms_v & mv_Salary(lng) & ", "
        ms_v = ms_v & mv_Bonus(lng) & ", "
        ms_v = ms_v & mv_Miles(lng) & ", "
        ms_v = ms_v & mv_Active(lng)
        ms_v = ms_v & " );"
        
        '-----------------
        '   Insert String
        '-----------------
        ms_ActiveCommand = vbNullString
        ms_ActiveCommand = ms_fld & ms_v
        
        '-----------------
        '   Command Insert
        '-----------------
        With mo_cmd
            .ActiveConnection = mo_cn
            .CommandText = ms_ActiveCommand
            .Execute
        End With
    Next

[JohnM3]

post 3 of 3

    '-----------------
    '   http://msaccessmemento.hubpages.com/hub/Stored_Procedure_in_MS_Access
    '   http://support.microsoft.com/kb/200190
    '   http://allenbrowne.com/func-DDL.html
    '   Add a View (Stored Proc) to Access
    '-----------------
    If Not mb_ExistsStoredProcLastName Then
        ms_SQLCreateView = vbNullString
        ms_Tmp = vbNullString
        ms_Tmp = " Create "
        ms_Tmp = ms_Tmp & " Proc "
        ms_Tmp = ms_Tmp & CON_STORED_PROC_LASTNAME
        ms_Tmp = ms_Tmp & " (inLastName Text(50)) "
        ms_Tmp = ms_Tmp & " as "
        ms_Tmp = ms_Tmp & "SELECT "
        ms_Tmp = ms_Tmp & " [LastName], "
        ms_Tmp = ms_Tmp & " [HireDate], "
        ms_Tmp = ms_Tmp & " [Salary] "
        ms_Tmp = ms_Tmp & " FROM "
        ms_Tmp = ms_Tmp & CON_TARGET_TABLE
        ms_Tmp = ms_Tmp & " WHERE "
        ms_Tmp = ms_Tmp & " [LastName] = inLastName "
        ms_Tmp = ms_Tmp & ";"
        ms_SQLCreateView = ms_Tmp
        '-----------------
        '   Execute
        '-----------------
        ms_ActiveCommand = ms_SQLCreateView
        With mo_cmd
            .ActiveConnection = mo_cn
            .CommandText = ms_ActiveCommand
            .Execute
        End With
    End If

    '-----------------
    '   http://msaccessmemento.hubpages.com/hub/Stored_Procedure_in_MS_Access
    '   http://support.microsoft.com/kb/200190
    '   http://allenbrowne.com/func-DDL.html
    '   Add a View (Stored Proc) to Access
    '-----------------
    If Not mb_ExistsStoredProcHireDate Then
        ms_SQLCreateView = vbNullString
        ms_Tmp = vbNullString
        ms_Tmp = " Create "
        ms_Tmp = ms_Tmp & " Proc "
        ms_Tmp = ms_Tmp & CON_STORED_PROC_HIREDATE
        ms_Tmp = ms_Tmp & " (inHireDate Date) "
        ms_Tmp = ms_Tmp & " as "
        ms_Tmp = ms_Tmp & "SELECT "
        ms_Tmp = ms_Tmp & " [LastName], "
        ms_Tmp = ms_Tmp & " [HireDate], "
        ms_Tmp = ms_Tmp & " [Salary] "
        ms_Tmp = ms_Tmp & " FROM "
        ms_Tmp = ms_Tmp & CON_TARGET_TABLE
        ms_Tmp = ms_Tmp & " WHERE "
        ms_Tmp = ms_Tmp & " [HireDate] = inHireDate "
        ms_Tmp = ms_Tmp & ";"
        ms_SQLCreateView = ms_Tmp
        '-----------------
        '   Execute
        '-----------------
        ms_ActiveCommand = ms_SQLCreateView
        With mo_cmd
            .ActiveConnection = mo_cn
            .CommandText = ms_ActiveCommand
            .Execute
        End With
    End If

    '-----------------
    '   http://msaccessmemento.hubpages.com/hub/Stored_Procedure_in_MS_Access
    '   http://support.microsoft.com/kb/200190
    '   http://allenbrowne.com/func-DDL.html
    '   Add a View (Stored Proc) to Access
    '-----------------
    If Not mb_ExistsStoredProcSalary Then
        ms_SQLCreateView = vbNullString
        ms_Tmp = vbNullString
        ms_Tmp = " Create "
        ms_Tmp = ms_Tmp & " Proc "
        ms_Tmp = ms_Tmp & CON_STORED_PROC_SALARY
        ms_Tmp = ms_Tmp & " (inSalary Decimal(6)) "
        ms_Tmp = ms_Tmp & " as "
        ms_Tmp = ms_Tmp & "SELECT "
        ms_Tmp = ms_Tmp & " [LastName], "
        ms_Tmp = ms_Tmp & " [HireDate], "
        ms_Tmp = ms_Tmp & " [Salary] "
        ms_Tmp = ms_Tmp & " FROM "
        ms_Tmp = ms_Tmp & CON_TARGET_TABLE
        ms_Tmp = ms_Tmp & " WHERE "
        ms_Tmp = ms_Tmp & " [Salary] = inSalary "
        ms_Tmp = ms_Tmp & ";"
        ms_SQLCreateView = ms_Tmp
        '-----------------
        '   Execute
        '-----------------
        ms_ActiveCommand = ms_SQLCreateView
        With mo_cmd
            .ActiveConnection = mo_cn
            .CommandText = ms_ActiveCommand
            .Execute
        End With
    End If

    '-----------------
    '   http://support.microsoft.com/kb/200190
    '   Create Parameter
    '-----------------
    Set mo_param_LastName = Nothing
    Set mo_param_LastName = New ADODB.Parameter
    With mo_param_LastName
        .Name = "[inLastName]"
        .Type = adWChar
        .Direction = adParamInput
        .Size = 5
        .Value = "Brown"
    End With
        
    '-----------------
    '   http://support.microsoft.com/kb/200190
    '   Create Parameter
    '-----------------
    Set mo_param_Date = Nothing
    Set mo_param_Date = New ADODB.Parameter
    With mo_param_Date
        .Name = "[inHireDate]"
        .Type = adDate
        .Direction = adParamInput
        .Value = "2/1/2002"
    End With
        
    '-----------------
    '   http://support.microsoft.com/kb/200190
    '   Create Parameter
    '-----------------
    Set mo_param_Salary = Nothing
    Set mo_param_Salary = New ADODB.Parameter
    With mo_param_Salary
        .Name = "[inSalary]"
        .Type = adDecimal
        .Precision = 6
        .Direction = adParamInput
        .Value = "85000"
    End With

    '-----------------
    '   Choose Which Proce to run
    '-----------------
    mi_Case = 3
    
    '-----------------
    '   http://support.microsoft.com/kb/200190
    '   Execute Command Object
    '-----------------
    Select Case mi_Case
    Case 1
        With mo_cmd
            .Parameters.Append mo_param_LastName
            .CommandText = CON_STORED_PROC_LASTNAME
            .CommandType = adCmdStoredProc
            Set mo_rs = .Execute
        End With
    Case 2
        With mo_cmd
            .Parameters.Append mo_param_Date
            .CommandText = CON_STORED_PROC_HIREDATE
            .CommandType = adCmdStoredProc
            Set mo_rs = .Execute
        End With
    Case 3
        With mo_cmd
            .Parameters.Append mo_param_Salary
            .CommandText = CON_STORED_PROC_SALARY
            .CommandType = adCmdStoredProc
            Set mo_rs = .Execute
        End With
    End Select
    
    '-----------------
    '   Server Side Cursor
    '   RecordCount will = -1
    '-----------------
    'MsgBox mo_rs.RecordCount
    
    '-----------------
    '   Write to WS
    '-----------------
    Sheets(1).Select
    Cells.ClearContents
    Range("a1").Select
    Range("a1").CopyFromRecordset mo_rs

    '-----------------
    '   Incomplete Exit
    '-----------------
    Set mo_cn = Nothing
    Set mo_cmd = Nothing
    Set mo_rs = Nothing
    Exit Sub
EH_Main:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "Public Sub Main()"
    Set mo_cn = Nothing
    Set mo_cmd = Nothing
    Exit Sub

End Sub

[Kyle123]

Hi John, great bit of code

Just to reiterate, John's code only works for input parameters, unfortunately it can't be used for output parameters.