Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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." wrote in message ... 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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" skrev i melding ... 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." wrote in message ... 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 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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." wrote in message ... 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 |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 On 25 Jun, 04:13, "NickHK" wrote: 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 "Jan T." wrote in message ... Hi. I use Office 2k and have made a function that should return a sum from a Access database usingADO. 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. 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 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? 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- Skjul sitert tekst - - Vis sitert tekst - |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Late binding | Excel Programming | |||
Late Binding | Excel Programming | |||
Late Binding examples of binding excel application | Excel Programming | |||
Late Binding help, Please | Excel Programming | |||
EARLY binding or LATE binding ? | Excel Programming |