Consulting

Results 1 to 4 of 4

Thread: Parameterized MySQL SP as Form data input

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #4
    VBAX Regular
    Joined
    Jul 2022
    Posts
    7
    Location
    I was able to solve it on my own. Yippy!

    Part of my problem dispirited above, was a wrong CursorLocation/CursorType. It was set to adUseServer

    For anybody interested some code of my current solution follows (Inspired by some internet sources). Error handling is still missing nearly completely!
    Public Function load(ByVal procedurName As String, ParamArray params()) As ADODB.Recordset
        Dim cmd As ADODB.Command
        Dim rst As New ADODB.Recordset
            
        rst.CursorLocation = adUseClient
        
        Set cmd = createCmd(procedurName, params)
        rst.Open cmd
        Set load = rst
    End Function
    
    
    
    Private Function createParam(ByVal pName As String, pValue)
        Dim param As New ADODB.Parameter
        
        With param
            .name = pName
            .Direction = adParamInput
            If TypeName(pValue) = "String" Then
                .Type = adVarChar
                .Size = Len(CStr(pValue))
                .value = CStr(pValue)
            ElseIf TypeName(pValue) = "Integer" Then
                .Type = adInteger
                .value = CInt(pValue)
            ElseIf TypeName(pValue) = "Double" Then
                .Type = adDouble
                .value = CDbl(pValue)
            Else
                errMsg = "Kein Parametermapping für " & TypeName(pValue) & " hinterlegt."
                GoTo FEHLER
            End If
        End With
        Set createParam = param
        Exit Function
        
    FEHLER:
        Debug.Print "RDAO.createParam > Es ist eine Fehler aufgetreten: " & errMsg
    End Function
    
    
    
    Private Function createCmd(ByVal spName As String, ParamArray params())
        Dim errMsg As String
        Dim cmd As New ADODB.Command
        
        If (UBound(params(0)) - (LBound(params(0)) + 1)) Mod 2 <> 0 Then
            errMsg = "Anzahl der Parameter darf nicht ungerade sein."
            GoTo FEHLER
        End If
        
        openConn
        
        With cmd
            .ActiveConnection = conn
            .CommandText = spName ' SP
            .CommandType = adCmdStoredProc
            .CommandTimeout = 15
        End With
    
        For i = LBound(params(0)) To UBound(params(0))
            cmd.Parameters.Append createParam(params(0)(i), params(0)(i + 1))
            i = i + 1
        Next i
    
        Set createCmd = cmd
        Exit Function
        
    FEHLER:
        Debug.Print "RDAO.createCmd > Es ist eine Fehler aufgetreten: " & errMsg
    End Function
    Last edited by ArneG; 07-26-2022 at 04:27 AM.

Posting Permissions

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