Consulting

Results 1 to 2 of 2

Thread: Query Access database with parameters on Excel sheet.

  1. #1

    Query Access database with parameters on Excel sheet.

    Hello to all,
    I found a piece of code on internet and adapted it to my needs, as you can see bellow. It works fine, getting the data from an Access database and returning it into an Excel spreadsheet. User enters the two parameters on the Excel spreadsheet and data is automatically refreshed. My problem is that there are hundreds (thousands, perhaps) of spreadsheet lines (queries) which causes slow data returning. I am opening and closing the connection per each query. That does not look good to me...but I don't know how to do it other way.
    My question is if there is a better way of achieving this goal. I don’t have much knowledge on VBA and perhaps there is a better way of writing the code or even a different approach to get the same result.
    Many thanks in advance for any help.

    Public Const BDados As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\10.172.2.46\Finance2\Dados\SAP_BALANCES_FY.accdb"
    
    Private Function GetFYBalPV03(p1 As Variant, p2 As Variant) As Double
    On Error GoTo erro
    Dim aux As String
    Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim ccmd As New ADODB.Command
    Dim PA1 As New ADODB.Parameter, PA2 As New ADODB.Parameter
    
    
    cnt.Open BDados
    ccmd.ActiveConnection = cnt
    ccmd.CommandText = "SELECT SUM(YTD_BALANCE_DR - YTD_BALANCE_CR) FROM BALANCETES_PV03 WHERE CONTA=? AND PER_SAP=?"
    ccmd.CommandType = adCmdText
    
    
    Set PA1 = ccmd.CreateParameter("first", adVariant, adParamInput, 1, p1)
    Set PA2 = ccmd.CreateParameter("second", adVariant, adParamInput, 1, p2)
    
    
    ccmd.Parameters.Append PA1
    ccmd.Parameters.Append PA2
    
    
    Set rst = ccmd.Execute
    
    
    GetFYBalPV03 = rst.Fields(0).Value
    
    
    rst.Close
    Set rst = Nothing
    cnt.Close
    Set cnt = Nothing
    
    
    If Err.Number <> 0 Then
    erro:     aux = MsgBox(CStr(Err.Number) & ":" & Err.Description, vbOKOnly, "ERRO - " & Err.Source)
    End If
    
    End Function


  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    look for: 'copyfromrecordset'

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •