Monthly Archives: January 2014

VBA: Run-time error 3001 Arguments Are Of The Wrong Type… when setting ADODB.Command object members

This forum post saved my day.
I was trying to run Oracle stored procedure with output parameters from Excel VBA with the following piece of code:


Dim cmd As Object
Dim resultSet As Object
Set cmd = CreateObject("ADODB.Command")
With cmd
.CommandText = "PK_AUTH.LOGON"
.NamedParameters = True
.Parameters.Append .CreateParameter("login", adVarChar, adParamInput, 50, login_)
.Parameters.Append .CreateParameter("pass", adVarChar, adParamInput, 50, pass_)
.Parameters.Append .CreateParameter("ldb", adVarChar, adParamOutput, 50)
.Parameters.Append .CreateParameter("pdb", adVarChar, adParamOutput, 50)
.CommandType = adCmdStoredProc
.ActiveConnection = GetConn_()
Set resultSet = .Execute
ldb_ = .Parameters.Item("ldb")
End With

And I always got Run-time error 3001 ‘Arguments Are Of The Wrong Type, Are Out Of The Acceptable Range, or are in conflict with one another’ upon invocation of

.CommandType = adCmdStoredProc

or

.Parameters.Append .CreateParameter(...)

no matter which statement I placed first.
After fighting for a while I found this post that stated that error is fired because of late binding of library references, so VB simply did not know of adCmdStoredProc and other constants
That meant that this error has nothing to do with ADODB or Ole or, I just said that it does not know the value of constant. Not very informative in fact…
So, I simply added


Const adVarChar As Long = 200
Const adParamInput As Long = &H1
Const adParamOutput As Long = &H2
Const adCmdStoredProc As Long = &H4

to the Sub header and everything worked fine. Constants are defined in c:Program FilesCommon FilesSystemadoadovbs.inc

VBA: Prototype Class than connects to oracle and checks if connection is up. Plus VBA singleton pattern

Here some prototyping code of a class that is able to connect to Oracle through OleDB and to check if the connection is up before doing some application logic. Class name is TUploadHelper.


Private m_conn As Object

Private Function GetConn_() As Object
If m_conn Is Nothing Then
Set m_conn = CreateObject("ADODB.Connection")
End If
Set GetConn_ = m_conn
End Function

Private Function Connected_() As Boolean
Dim recordSet As Object
Dim value As Long
Dim errCode As Variant
Dim errMsg As Variant

If Not PopErrors() Then On Error GoTo L_ERR_HANDLER

value = 0
Connected_ = False

Set recordSet = CreateObject("ADODB.Recordset")

Set recordSet.ActiveConnection = GetConn_()

recordSet.Open "select 1 as value_ from dual"
While Not recordSet.EOF
value = recordSet.Fields(0)
If 1 = value Then
Connected_ = True
GoTo L_CLEANUP
End If
Wend
' не вернулось ни одной записи
L_ERR_HANDLER:
errCode = Err.Number
errMsg = Err.Description
L_CLEANUP:
On Error GoTo 0
If 1 = recordSet.State Then
recordSet.Close
End If
Set recordSet = Nothing
End Function


Private Sub Class_Deinitialize()
If Not m_conn Is Nothing Then
If 1 = m_conn.State Then
m_conn.Close
End If
Set m_conn = Nothing
End If
End Sub

Private Function Authorized_() As Boolean
Authorized_ = False
End Function

Private Sub Connect_()
' Dim state_ As Variant
m_conn.Open "Provider=OraOLEDB.Oracle;Data Source=your_server.world;User ID=your_user;Password=your_pass;PLSQLRSet=1;"
' state_ = m_conn.State
End Sub

Public Sub Ut()
If Not Connected_ Then
Connect_
If Not Connected_ Then
End If
End If
End Sub

And here is module code that implements singleton pattern for TUploadHelper object.


'Singleton pattern
Private g_uploadHelper As TUploadHelper
Public Property Get GetUploadHelper() As TUploadHelper
If g_uploadHelper Is Nothing Then
Set g_uploadHelper = New TUploadHelper
End If
Set GetUploadHelper = g_uploadHelper
End Property