Using ADO and Late Binding

J

Jan T.

Hi. I use Office 2k and have made a function that should return
a sum from a Access database using ADO.

My function works fine as long as I set a reference to ADO 2.8.
However, I want to use late binding because the function should
be used of different users with different versions of ADO. Setting
a reference to ADO 2.8 when only ADO 2.6 is installed on the
users machine, will cause an error.

Therefore rather than setting the reference from Tools/References
I use the CreateObject function to set a reference.

When running the code below, it works fine when I set the reference.
But when I uncheck the reference I get error code 3001, The arguments
are of wrong type, out of valid range or in conflict with each other?

How is this possible when I use late binding? When setting a reference
there is no problem even without changing any code. I thought that
CreateObject would do the same as setting a reference, right?

Here is the code I use:

Function SjekkTimerPeriode(lngId As Long, lngDays As Long, _
Optional myDate As Date = 0, Optional lngArbØkt As Long = 0) As Double
Dim strSQL As String
Dim strDato As String
Dim objCon As Object
Dim objRst As Object
Set objCon = CreateObject("ADODB.Connection")
Set objRst = CreateObject("ADODB.Recordset")

If myDate = 0 Then myDate = Date
If IsNull(lngId) Then
SjekkTimerPeriode = 0
Exit Function
End If

strDato = "#" & Month(myDate) & "/" & Day(myDate) & "/" & Year(myDate) &
"#"

strSQL = "SELECT Sum(([TilTid]-[FraTid])*24) AS AntallTimer"
strSQL = strSQL & " FROM AvspaseringOvertid"
strSQL = strSQL & " WHERE (((AvspaseringOvertid.Ansattid)=" & lngId &
" )"
If lngArbØkt <> 0 Then
strSQL = strSQL & " AND (AvspaseringOvertid.ArbØktId <> " &
lngArbØkt & ")"
End If
strSQL = strSQL & " AND ((AvspaseringOvertid.ArbeidsDato)"
strSQL = strSQL & " Between " & strDato & " - " & lngDays & " And " &
strDato & ")"
strSQL = strSQL & " AND (AvspaseringOvertid.RealiserTil <> 4));"

' open the connection
With objCon
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open gstrDBfil ' S:
End With

' Define the Recordset
objRst.CursorLocation = adUseServer 'HERE I GET AN ERROR
' open the table AND THEN NEXT LINES...
objRst.Open Source:=strSQL, _
ActiveConnection:=objCon, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdText


If IsNull(objRst("AntallTimer")) Then
SjekkTimerPeriode = 0
Else
SjekkTimerPeriode = objRst("AntallTimer")
End If
objRst.Close
Set objRst = Nothing
End Function
-----------------------------------------------------------------

Any help with this would be very much appreciated.
Thanx in advance!

Regards
Jan
 
R

RB Smissaert

It is a bit tricky, but it is possible to use ADO with early binding.
The following code will give you the idea how to do this.
Note that the .xla is saved with a low ADO version reference. On opening
the wb this reference will then be removed and the most up to date version
that is avaiable will then be referenced.

Sub SetADOReference()

'removes any existing ADO reference then adds the current ADO library
'--------------------------------------------------------------------
Dim i As Byte
Dim ADOConn As Object
Dim strADOVersion As String
Dim strADOFolder As String
Dim strADOFile As String
Dim strADOPathFromINI As String
Dim arrADOFiles

strADOPathFromINI = ReadINIValue(strINIPath, _
"Add-in behaviour", _
"Full path to ADO library")

If InStr(1, strADOPathFromINI, ":\", vbBinaryCompare) > 0 Then
If bFileExistsVBA(strADOPathFromINI) Then
If AddProjectReference(, , , "ADODB", False, True, , , , , _
strADOPathFromINI, False) = True Then
Exit Sub
End If
End If
End If

strADOFolder = Left$(Application.Path, 1) & _
":\Program Files\Common Files\System\ADO\"

Set ADOConn = CreateObject("ADODB.Connection")
strADOVersion = Left$(ADOConn.Version, 3)
Set ADOConn = Nothing

Select Case strADOVersion
Case "2.8"
strADOFile = "msado15.dll"
Case "2.7"
strADOFile = "msado27.tlb"
Case "2.6"
strADOFile = "msado26.tlb"
Case "2.5"
strADOFile = "msado25.tlb"
Case "2.1"
strADOFile = "msado21.tlb"
Case "2.0"
strADOFile = "msado20.tlb"
End Select

If AddProjectReference(, , , "ADODB", False, True, , , , , _
strADOFolder & strADOFile, False) = True Then
Exit Sub
End If

arrADOFiles = Array("msado15.dll", "msado27.tlb", "msado26.tlb", _
"msado25.tlb", "msado21.tlb", "msado20.tlb")

For i = 0 To 5
If AddProjectReference(, , , "ADODB", False, True, , , , , _
strADOFolder & arrADOFiles(i), False) = True
Then
Exit Sub
End If
Next i

MsgBox "Failed to add the ADO reference" & vbCrLf & vbCrLf & _
"Please xxxxxx" & _
vbCrLf & vbCrLf & _
"Or install the latest version after downloading the MDAC
installation from Microsoft." & _
vbCrLf & vbCrLf & "Google to this with: Microsoft MDAC download",
_
vbExclamation, "adding ADO reference"

End Sub

Function AddProjectReference(Optional strGUID As String, _
Optional lMajor As Long, _
Optional lMinor As Long, _
Optional strRefName As String = "", _
Optional bRemove As Boolean, _
Optional bRemoveAndAdd As Boolean, _
Optional bArray As Boolean, _
Optional vGUIDArray As Variant, _
Optional strObjectString As String, _
Optional strWorkbook As String, _
Optional strFilePath As String, _
Optional bMessage As Boolean = True) As Boolean

Dim oRef As Reference
Dim VBProj As VBProject
Dim i As Byte
Dim bSuccess As Boolean

If Len(strWorkbook) = 0 Then
strWorkbook = ThisWorkbook.Name
End If

Set VBProj = Workbooks(strWorkbook).VBProject

'removing references
'-------------------
For Each oRef In VBProj.References
If oRef.Name = strRefName Then
If oRef.IsBroken Then
'so remove any broken references
'-------------------------------
VBProj.References.Remove oRef
Else
If bRemove Or bRemoveAndAdd Then
VBProj.References.Remove oRef ' >> error here when
scheduling IB 2 SQLite
If bRemove Then
AddProjectReference = True
End If
End If
End If
End If
Next oRef

If bRemove Then
Exit Function
End If

'adding references
'-----------------
If Len(strFilePath) = 0 Then
'not adding directly from file
'-----------------------------
If Len(strObjectString) = 0 Then
If bArray Then 'trying an array of GUID's and version numbers
On Error Resume Next
For i = 1 To UBound(vGUIDArray)
Set oRef = VBProj.References.AddFromGuid(GUID:=vGUIDArray(i,
1), _
Major:=vGUIDArray(i,
2), _
Minor:=vGUIDArray(i,
3))
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) > 0
If bSuccess Then
AddProjectReference = True
WriteIniValue strINIPath, _
"Add-in behaviour", _
"ADO reference added", _
vGUIDArray(i, 2) & "." & vGUIDArray(i, 3)
Exit Function
Else
VBProj.References.Remove oRef
End If
End If
Next i
GoTo ERROROUT 'as we couldn't add any of the references
Else
On Error Resume Next
Set oRef = VBProj.References.AddFromGuid(GUID:=strGUID, _
Major:=lMajor, _
Minor:=lMinor)
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) > 0 'just for in case the len
is 0 without error
If bSuccess Then
AddProjectReference = True 'as we got here without an
error
Else
VBProj.References.Remove oRef
GoTo ERROROUT
End If
End If
End If
Else
'adding from file via registry reads
'-----------------------------------
On Error GoTo ERROROUT
AddProjectReference = AddRefFromFileWithRegReads(strObjectString,
strWorkbook)
End If
Else
'adding directly from file
'-------------------------
On Error Resume Next
If bFileExistsVBA(strFilePath) Then
Set oRef = VBProj.References.AddFromFile(strFilePath)
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) > 0
If bSuccess Then
AddProjectReference = True
Else
VBProj.References.Remove oRef
GoTo ERROROUT
End If
End If
Else
If bMessage Then
MsgBox "Couldn't add the " & strRefName & " reference as the
file:" & _
vbCrLf & _
strFilePath & vbCrLf & _
"is missing." & vbCrLf & vbCrLf & _
"Run the installer on this PC", vbExclamation, _
"adding " & strRefName & " reference"
End If
End If
End If

If bRemove = False Then
WriteIniValue strINIPath, _
"Add-in behaviour", _
"Added " & strRefName & " library file path", _
oRef.FullPath
End If

Exit Function
ERROROUT:

If bMessage Then
MsgBox "Couldn't add the " & strRefName & " reference", , _
"adding references to VB Project"
End If
On Error GoTo 0

End Function


RBS


Jan T. said:
Hi. I use Office 2k and have made a function that should return
a sum from a Access database using ADO.

My function works fine as long as I set a reference to ADO 2.8.
However, I want to use late binding because the function should
be used of different users with different versions of ADO. Setting
a reference to ADO 2.8 when only ADO 2.6 is installed on the
users machine, will cause an error.

Therefore rather than setting the reference from Tools/References
I use the CreateObject function to set a reference.

When running the code below, it works fine when I set the reference.
But when I uncheck the reference I get error code 3001, The arguments
are of wrong type, out of valid range or in conflict with each other?

How is this possible when I use late binding? When setting a reference
there is no problem even without changing any code. I thought that
CreateObject would do the same as setting a reference, right?

Here is the code I use:

Function SjekkTimerPeriode(lngId As Long, lngDays As Long, _
Optional myDate As Date = 0, Optional lngArbØkt As Long = 0) As Double
Dim strSQL As String
Dim strDato As String
Dim objCon As Object
Dim objRst As Object
Set objCon = CreateObject("ADODB.Connection")
Set objRst = CreateObject("ADODB.Recordset")

If myDate = 0 Then myDate = Date
If IsNull(lngId) Then
SjekkTimerPeriode = 0
Exit Function
End If

strDato = "#" & Month(myDate) & "/" & Day(myDate) & "/" & Year(myDate)
& "#"

strSQL = "SELECT Sum(([TilTid]-[FraTid])*24) AS AntallTimer"
strSQL = strSQL & " FROM AvspaseringOvertid"
strSQL = strSQL & " WHERE (((AvspaseringOvertid.Ansattid)=" & lngId &
" )"
If lngArbØkt <> 0 Then
strSQL = strSQL & " AND (AvspaseringOvertid.ArbØktId <> " &
lngArbØkt & ")"
End If
strSQL = strSQL & " AND ((AvspaseringOvertid.ArbeidsDato)"
strSQL = strSQL & " Between " & strDato & " - " & lngDays & " And " &
strDato & ")"
strSQL = strSQL & " AND (AvspaseringOvertid.RealiserTil <> 4));"

' open the connection
With objCon
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open gstrDBfil ' S:
End With

' Define the Recordset
objRst.CursorLocation = adUseServer 'HERE I GET AN ERROR
' open the table AND THEN NEXT LINES...
objRst.Open Source:=strSQL, _
ActiveConnection:=objCon, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdText


If IsNull(objRst("AntallTimer")) Then
SjekkTimerPeriode = 0
Else
SjekkTimerPeriode = objRst("AntallTimer")
End If
objRst.Close
Set objRst = Nothing
End Function
-----------------------------------------------------------------

Any help with this would be very much appreciated.
Thanx in advance!

Regards
Jan
Click to expand...
 
J

Jan T.

Wow, that was heavy... I can see what you mean with a bit trycky.

Well, I will have a closer look at it and try it out. Thank you very,
very much so far.

Regards
Jan



RB Smissaert said:
It is a bit tricky, but it is possible to use ADO with early binding.
The following code will give you the idea how to do this.
Note that the .xla is saved with a low ADO version reference. On opening
the wb this reference will then be removed and the most up to date version
that is avaiable will then be referenced.

Sub SetADOReference()

'removes any existing ADO reference then adds the current ADO library
'--------------------------------------------------------------------
Dim i As Byte
Dim ADOConn As Object
Dim strADOVersion As String
Dim strADOFolder As String
Dim strADOFile As String
Dim strADOPathFromINI As String
Dim arrADOFiles

strADOPathFromINI = ReadINIValue(strINIPath, _
"Add-in behaviour", _
"Full path to ADO library")

If InStr(1, strADOPathFromINI, ":\", vbBinaryCompare) > 0 Then
If bFileExistsVBA(strADOPathFromINI) Then
If AddProjectReference(, , , "ADODB", False, True, , , , , _
strADOPathFromINI, False) = True Then
Exit Sub
End If
End If
End If

strADOFolder = Left$(Application.Path, 1) & _
":\Program Files\Common Files\System\ADO\"

Set ADOConn = CreateObject("ADODB.Connection")
strADOVersion = Left$(ADOConn.Version, 3)
Set ADOConn = Nothing

Select Case strADOVersion
Case "2.8"
strADOFile = "msado15.dll"
Case "2.7"
strADOFile = "msado27.tlb"
Case "2.6"
strADOFile = "msado26.tlb"
Case "2.5"
strADOFile = "msado25.tlb"
Case "2.1"
strADOFile = "msado21.tlb"
Case "2.0"
strADOFile = "msado20.tlb"
End Select

If AddProjectReference(, , , "ADODB", False, True, , , , , _
strADOFolder & strADOFile, False) = True Then
Exit Sub
End If

arrADOFiles = Array("msado15.dll", "msado27.tlb", "msado26.tlb", _
"msado25.tlb", "msado21.tlb", "msado20.tlb")

For i = 0 To 5
If AddProjectReference(, , , "ADODB", False, True, , , , , _
strADOFolder & arrADOFiles(i), False) = True
Then
Exit Sub
End If
Next i

MsgBox "Failed to add the ADO reference" & vbCrLf & vbCrLf & _
"Please xxxxxx" & _
vbCrLf & vbCrLf & _
"Or install the latest version after downloading the MDAC
installation from Microsoft." & _
vbCrLf & vbCrLf & "Google to this with: Microsoft MDAC download",
_
vbExclamation, "adding ADO reference"

End Sub

Function AddProjectReference(Optional strGUID As String, _
Optional lMajor As Long, _
Optional lMinor As Long, _
Optional strRefName As String = "", _
Optional bRemove As Boolean, _
Optional bRemoveAndAdd As Boolean, _
Optional bArray As Boolean, _
Optional vGUIDArray As Variant, _
Optional strObjectString As String, _
Optional strWorkbook As String, _
Optional strFilePath As String, _
Optional bMessage As Boolean = True) As
Boolean

Dim oRef As Reference
Dim VBProj As VBProject
Dim i As Byte
Dim bSuccess As Boolean

If Len(strWorkbook) = 0 Then
strWorkbook = ThisWorkbook.Name
End If

Set VBProj = Workbooks(strWorkbook).VBProject

'removing references
'-------------------
For Each oRef In VBProj.References
If oRef.Name = strRefName Then
If oRef.IsBroken Then
'so remove any broken references
'-------------------------------
VBProj.References.Remove oRef
Else
If bRemove Or bRemoveAndAdd Then
VBProj.References.Remove oRef ' >> error here when
scheduling IB 2 SQLite
If bRemove Then
AddProjectReference = True
End If
End If
End If
End If
Next oRef

If bRemove Then
Exit Function
End If

'adding references
'-----------------
If Len(strFilePath) = 0 Then
'not adding directly from file
'-----------------------------
If Len(strObjectString) = 0 Then
If bArray Then 'trying an array of GUID's and version numbers
On Error Resume Next
For i = 1 To UBound(vGUIDArray)
Set oRef = VBProj.References.AddFromGuid(GUID:=vGUIDArray(i,
1), _

Major:=vGUIDArray(i, 2), _

Minor:=vGUIDArray(i, 3))
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) > 0
If bSuccess Then
AddProjectReference = True
WriteIniValue strINIPath, _
"Add-in behaviour", _
"ADO reference added", _
vGUIDArray(i, 2) & "." & vGUIDArray(i,
3)
Exit Function
Else
VBProj.References.Remove oRef
End If
End If
Next i
GoTo ERROROUT 'as we couldn't add any of the references
Else
On Error Resume Next
Set oRef = VBProj.References.AddFromGuid(GUID:=strGUID, _
Major:=lMajor, _
Minor:=lMinor)
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) > 0 'just for in case the len
is 0 without error
If bSuccess Then
AddProjectReference = True 'as we got here without an
error
Else
VBProj.References.Remove oRef
GoTo ERROROUT
End If
End If
End If
Else
'adding from file via registry reads
'-----------------------------------
On Error GoTo ERROROUT
AddProjectReference = AddRefFromFileWithRegReads(strObjectString,
strWorkbook)
End If
Else
'adding directly from file
'-------------------------
On Error Resume Next
If bFileExistsVBA(strFilePath) Then
Set oRef = VBProj.References.AddFromFile(strFilePath)
If Err.Number = 0 Then
bSuccess = Len(oRef.FullPath) > 0
If bSuccess Then
AddProjectReference = True
Else
VBProj.References.Remove oRef
GoTo ERROROUT
End If
End If
Else
If bMessage Then
MsgBox "Couldn't add the " & strRefName & " reference as the
file:" & _
vbCrLf & _
strFilePath & vbCrLf & _
"is missing." & vbCrLf & vbCrLf & _
"Run the installer on this PC", vbExclamation, _
"adding " & strRefName & " reference"
End If
End If
End If

If bRemove = False Then
WriteIniValue strINIPath, _
"Add-in behaviour", _
"Added " & strRefName & " library file path", _
oRef.FullPath
End If

Exit Function
ERROROUT:

If bMessage Then
MsgBox "Couldn't add the " & strRefName & " reference", , _
"adding references to VB Project"
End If
On Error GoTo 0

End Function


RBS


Jan T. said:
Hi. I use Office 2k and have made a function that should return
a sum from a Access database using ADO.

My function works fine as long as I set a reference to ADO 2.8.
However, I want to use late binding because the function should
be used of different users with different versions of ADO. Setting
a reference to ADO 2.8 when only ADO 2.6 is installed on the
users machine, will cause an error.

Therefore rather than setting the reference from Tools/References
I use the CreateObject function to set a reference.

When running the code below, it works fine when I set the reference.
But when I uncheck the reference I get error code 3001, The arguments
are of wrong type, out of valid range or in conflict with each other?

How is this possible when I use late binding? When setting a reference
there is no problem even without changing any code. I thought that
CreateObject would do the same as setting a reference, right?

Here is the code I use:

Function SjekkTimerPeriode(lngId As Long, lngDays As Long, _
Optional myDate As Date = 0, Optional lngArbØkt As Long = 0) As Double
Dim strSQL As String
Dim strDato As String
Dim objCon As Object
Dim objRst As Object
Set objCon = CreateObject("ADODB.Connection")
Set objRst = CreateObject("ADODB.Recordset")

If myDate = 0 Then myDate = Date
If IsNull(lngId) Then
SjekkTimerPeriode = 0
Exit Function
End If

strDato = "#" & Month(myDate) & "/" & Day(myDate) & "/" & Year(myDate)
& "#"

strSQL = "SELECT Sum(([TilTid]-[FraTid])*24) AS AntallTimer"
strSQL = strSQL & " FROM AvspaseringOvertid"
strSQL = strSQL & " WHERE (((AvspaseringOvertid.Ansattid)=" & lngId &
" )"
If lngArbØkt <> 0 Then
strSQL = strSQL & " AND (AvspaseringOvertid.ArbØktId <> " &
lngArbØkt & ")"
End If
strSQL = strSQL & " AND ((AvspaseringOvertid.ArbeidsDato)"
strSQL = strSQL & " Between " & strDato & " - " & lngDays & " And " &
strDato & ")"
strSQL = strSQL & " AND (AvspaseringOvertid.RealiserTil <> 4));"

' open the connection
With objCon
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open gstrDBfil ' S:
End With

' Define the Recordset
objRst.CursorLocation = adUseServer 'HERE I GET AN ERROR
' open the table AND THEN NEXT LINES...
objRst.Open Source:=strSQL, _
ActiveConnection:=objCon, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdText


If IsNull(objRst("AntallTimer")) Then
SjekkTimerPeriode = 0
Else
SjekkTimerPeriode = objRst("AntallTimer")
End If
objRst.Close
Set objRst = Nothing
End Function
-----------------------------------------------------------------

Any help with this would be very much appreciated.
Thanx in advance!

Regards
Jan
Click to expand...
Click to expand...
 
N

NickHK

Jan,
Because you are now using Late Binding, define constants/enums can no longer
be looked up in the Type Library. Hence, VBA has no idea what the value of
"adUseServer" is.

You can either define your own, better for readability:
Const adUseServer = 2

or use the numeric value:
objRst.CursorLocation = 2

You can the value from the Object Browser, with a reference set to ADO.

NickHK

Jan T. said:
Hi. I use Office 2k and have made a function that should return
a sum from a Access database using ADO.

My function works fine as long as I set a reference to ADO 2.8.
However, I want to use late binding because the function should
be used of different users with different versions of ADO. Setting
a reference to ADO 2.8 when only ADO 2.6 is installed on the
users machine, will cause an error.

Therefore rather than setting the reference from Tools/References
I use the CreateObject function to set a reference.

When running the code below, it works fine when I set the reference.
But when I uncheck the reference I get error code 3001, The arguments
are of wrong type, out of valid range or in conflict with each other?

How is this possible when I use late binding? When setting a reference
there is no problem even without changing any code. I thought that
CreateObject would do the same as setting a reference, right?

Here is the code I use:

Function SjekkTimerPeriode(lngId As Long, lngDays As Long, _
Optional myDate As Date = 0, Optional lngArbØkt As Long = 0) As Double
Dim strSQL As String
Dim strDato As String
Dim objCon As Object
Dim objRst As Object
Set objCon = CreateObject("ADODB.Connection")
Set objRst = CreateObject("ADODB.Recordset")

If myDate = 0 Then myDate = Date
If IsNull(lngId) Then
SjekkTimerPeriode = 0
Exit Function
End If

strDato = "#" & Month(myDate) & "/" & Day(myDate) & "/" & Year(myDate) &
"#"

strSQL = "SELECT Sum(([TilTid]-[FraTid])*24) AS AntallTimer"
strSQL = strSQL & " FROM AvspaseringOvertid"
strSQL = strSQL & " WHERE (((AvspaseringOvertid.Ansattid)=" & lngId &
" )"
If lngArbØkt <> 0 Then
strSQL = strSQL & " AND (AvspaseringOvertid.ArbØktId <> " &
lngArbØkt & ")"
End If
strSQL = strSQL & " AND ((AvspaseringOvertid.ArbeidsDato)"
strSQL = strSQL & " Between " & strDato & " - " & lngDays & " And " &
strDato & ")"
strSQL = strSQL & " AND (AvspaseringOvertid.RealiserTil <> 4));"

' open the connection
With objCon
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open gstrDBfil ' S:
End With

' Define the Recordset
objRst.CursorLocation = adUseServer 'HERE I GET AN ERROR
' open the table AND THEN NEXT LINES...
objRst.Open Source:=strSQL, _
ActiveConnection:=objCon, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdText


If IsNull(objRst("AntallTimer")) Then
SjekkTimerPeriode = 0
Else
SjekkTimerPeriode = objRst("AntallTimer")
End If
objRst.Close
Set objRst = Nothing
End Function
-----------------------------------------------------------------

Any help with this would be very much appreciated.
Thanx in advance!

Regards
Jan
Click to expand...
 
J

Jan T.

Thank you very, very much. I did not read your contribution before
now. Sorry I did not answer you before.
But thank you anyway. That also is very important information to me.

Jan





Jan,
Because you are now usingLateBinding, define constants/enums can no longer
be looked up in the Type Library. Hence, VBA has no idea what the value of
"adUseServer" is.

You can either define your own, better for readability:
Const adUseServer = 2

or use the numeric value:
objRst.CursorLocation = 2

You can the value from the Object Browser, with a reference set toADO.

NickHK




Hi. I use Office 2k and have made a function that should return
a sum from a Access database usingADO.
Click to expand...
My function works fine as long as I set a reference toADO2.8.
However, I want to uselatebindingbecause the function should
be used of different users with different versions ofADO. Setting
a reference toADO2.8 when onlyADO2.6 is installed on the
users machine, will cause an error.
Click to expand...
Therefore rather than setting the reference from Tools/References
I use the CreateObject function to set a reference.
Click to expand...
When running the code below, it works fine when I set the reference.
But when I uncheck the reference I get error code 3001, The arguments
are of wrong type, out of valid range or in conflict with each other?
Click to expand...
How is this possible when I uselatebinding? When setting a reference
there is no problem even without changing any code. I thought that
CreateObject would do the same as setting a reference, right?
Click to expand...
Here is the code I use:
Click to expand...
Function SjekkTimerPeriode(lngId As Long, lngDays As Long, _
Optional myDate As Date = 0, Optional lngArbØkt As Long = 0) As Double
Dim strSQL As String
Dim strDato As String
Dim objCon As Object
Dim objRst As Object
Set objCon = CreateObject("ADODB.Connection")
Set objRst = CreateObject("ADODB.Recordset")
Click to expand...
If myDate = 0 Then myDate = Date
If IsNull(lngId) Then
SjekkTimerPeriode = 0
Exit Function
End If
Click to expand...
strDato = "#" & Month(myDate) & "/" & Day(myDate) & "/" & Year(myDate) &
"#"
Click to expand...

strSQL = "SELECT Sum(([TilTid]-[FraTid])*24) AS AntallTimer"
strSQL = strSQL & " FROM AvspaseringOvertid"
strSQL = strSQL & " WHERE (((AvspaseringOvertid.Ansattid)=" & lngId &
" )"
If lngArbØkt <> 0 Then
strSQL = strSQL & " AND (AvspaseringOvertid.ArbØktId <> " &
lngArbØkt & ")"
End If
strSQL = strSQL & " AND ((AvspaseringOvertid.ArbeidsDato)"
strSQL = strSQL & " Between " & strDato & " - " & lngDays & " And" &
strDato & ")"
strSQL = strSQL & " AND (AvspaseringOvertid.RealiserTil <> 4));"
Click to expand...
' open the connection
With objCon
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open gstrDBfil ' S:
End With
Click to expand...
' Define the Recordset
objRst.CursorLocation = adUseServer 'HERE I GET AN ERROR
' open the table AND THEN NEXT LINES...
objRst.Open Source:=strSQL, _
ActiveConnection:=objCon, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdText
Click to expand...
If IsNull(objRst("AntallTimer")) Then
SjekkTimerPeriode = 0
Else
SjekkTimerPeriode = objRst("AntallTimer")
End If
objRst.Close
Set objRst = Nothing
End Function
-----------------------------------------------------------------
Click to expand...
Any help with this would be very much appreciated.
Thanx in advance!
Click to expand...
Regards
Jan- Skjul sitert tekst -
Click to expand...

- Vis sitert tekst -
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

ADO OpenDatabaseConnection 2
Add Records to a Table 2
ADO adStateOpen = 0 2
Delimiter for csv and text file using ADO 1
using ado to query the contents of a spreadsheet 6
How query a disconnected ADO recordset - possible? 5
REPOST - Moving Data From Excel into Access 5
Help with using ADO to connect Excel to Access 4

Top