Hi,
I'm trying to repair part of a database which was set up some time ago. When we moved on sql server 2005 the code below started throwing up this error:
Runtime Error '3709' Requested operation requires an ole db session object which is not supported by the current provider.
It's on the line in red near the bottom of the code.
This was creating by someone else and I'm no expert so really need help!!
Private Sub btnStep4_Click()
On Error GoTo Err_fnImport
Dim myDB As DAO.Database
Dim qdf1 As DAO.QueryDef
Dim strSQL As String
Dim intBatchNum As Integer
Dim intDuplicates As Integer
Dim strMsg As String
Dim intDupID As Long
Dim intPerID As Long
Dim rstUDImport As ADODB.Recordset
Dim rstUpdate As ADODB.Recordset
Dim rstImportThese As ADODB.Recordset
Dim i_Added As Integer
Dim i_Existing As Integer
Dim i_Booked As Integer
'Variables below are for the Stored Procedures
Dim cmd As ADODB.Command
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
'Set up the connection
Set con = CurrentProject.Connection
'Initialise variables
i_Added = 0
i_Existing = 0
i_Booked = 0
'1) Validate
If Nz(Me.txtEvtID, 0) = 0 Then
MsgBox "Event ID is missing - you can resurrect this now by typing the ID of the event into the event ID text box, otherwise abandon this import!", vbInformation, "CANNOT PROCEED"
Me.txtEvtID.SetFocus
Exit Sub
End If
If Nz(Me.txtBatchNum, 0) = 0 Then
MsgBox "There is no batch number set: either re-import the spreadsheet, which will generate one automatically, or type in a number from memory which is higher than the existing highest batch number (i.e. see outtblPeople, field perBatchNum)!", vbInformation, "CANNOT PROCEED"
Me.txtBatchNum.SetFocus
Exit Sub
End If
intEvtID = Me.txtEvtID
intBatchNum = Me.txtBatchNum
'2) DUPLICATE CHECK PROCEDURE
'If a record contains the same first name and surname as an existing record then it is prima facie a duplicate
'This next process asks the user whether s/he wants to import it anyway,
'If yes, nothing extraordinary happens: it gets imported and there will be two Kate Smiths or whoever
'If no, there is a further question: book existing contact onto the summer school OR
'Leave the record behind in the import table.
'Uses the function MessageForm which is in the module mdlMsgBox
'This enables customised message boxes
Dim rstDup As ADODB.Recordset
Set rstDup = GetRecordsetFromSQL("SELECT ID, fName, sName, perID, ImportDOB, DBDOB FROM evtqvwPotentialDuplicates", adOpenForwardOnly, adLockOptimistic)
With rstDup
Dim i As Long
For i = 1 To rstDup.RecordCount
strMsg = Nz(!Fname, "Error") & " " & Nz(!Sname, "Error") & " already appears in the database as contact " & Nz(!perID, 0) & _
", with birthday " & Nz(!DBDOB, "Unknown") & ". The record you are importing has a birthday on " & Nz(!ImportDOB, "Unknown") & vbCrLf & _
"Please choose your course of action:"
' MsgBox strMsg
Select Case MessageForm(strMsg, 240, "W A R N I N G")
Case Is = 1
' MsgBox "You want to import it anyway"
'Leave ImportInstruction blank
'Do nothing: Set it to blank in case it was not previously blank, likewise the perID
intDupID = rstDup!Id
'STORED PROCEDURE
Set cmd = New ADODB.Command
cmd.ActiveConnection = con
cmd.CommandType = adCmdStoredProc
'This tells Access the name of the Stored Procedure
cmd.CommandText = "evt_sp_UD_ImportTemp"
'This gives the stored procedure the relevant parameters
cmd.Parameters.Append cmd.CreateParameter("myperID", adInteger, adParamInput, , Null)
cmd.Parameters.Append cmd.CreateParameter("MyID", adInteger, adParamInput, , intDupID)
cmd.Parameters.Append cmd.CreateParameter("IIID", adSmallInt, adParamInput, , Null)
cmd.Execute
Set cmd = Nothing
'ThrowawayRecordset rstUDImport
I'm trying to repair part of a database which was set up some time ago. When we moved on sql server 2005 the code below started throwing up this error:
Runtime Error '3709' Requested operation requires an ole db session object which is not supported by the current provider.
It's on the line in red near the bottom of the code.
This was creating by someone else and I'm no expert so really need help!!
Private Sub btnStep4_Click()
On Error GoTo Err_fnImport
Dim myDB As DAO.Database
Dim qdf1 As DAO.QueryDef
Dim strSQL As String
Dim intBatchNum As Integer
Dim intDuplicates As Integer
Dim strMsg As String
Dim intDupID As Long
Dim intPerID As Long
Dim rstUDImport As ADODB.Recordset
Dim rstUpdate As ADODB.Recordset
Dim rstImportThese As ADODB.Recordset
Dim i_Added As Integer
Dim i_Existing As Integer
Dim i_Booked As Integer
'Variables below are for the Stored Procedures
Dim cmd As ADODB.Command
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
'Set up the connection
Set con = CurrentProject.Connection
'Initialise variables
i_Added = 0
i_Existing = 0
i_Booked = 0
'1) Validate
If Nz(Me.txtEvtID, 0) = 0 Then
MsgBox "Event ID is missing - you can resurrect this now by typing the ID of the event into the event ID text box, otherwise abandon this import!", vbInformation, "CANNOT PROCEED"
Me.txtEvtID.SetFocus
Exit Sub
End If
If Nz(Me.txtBatchNum, 0) = 0 Then
MsgBox "There is no batch number set: either re-import the spreadsheet, which will generate one automatically, or type in a number from memory which is higher than the existing highest batch number (i.e. see outtblPeople, field perBatchNum)!", vbInformation, "CANNOT PROCEED"
Me.txtBatchNum.SetFocus
Exit Sub
End If
intEvtID = Me.txtEvtID
intBatchNum = Me.txtBatchNum
'2) DUPLICATE CHECK PROCEDURE
'If a record contains the same first name and surname as an existing record then it is prima facie a duplicate
'This next process asks the user whether s/he wants to import it anyway,
'If yes, nothing extraordinary happens: it gets imported and there will be two Kate Smiths or whoever
'If no, there is a further question: book existing contact onto the summer school OR
'Leave the record behind in the import table.
'Uses the function MessageForm which is in the module mdlMsgBox
'This enables customised message boxes
Dim rstDup As ADODB.Recordset
Set rstDup = GetRecordsetFromSQL("SELECT ID, fName, sName, perID, ImportDOB, DBDOB FROM evtqvwPotentialDuplicates", adOpenForwardOnly, adLockOptimistic)
With rstDup
Dim i As Long
For i = 1 To rstDup.RecordCount
strMsg = Nz(!Fname, "Error") & " " & Nz(!Sname, "Error") & " already appears in the database as contact " & Nz(!perID, 0) & _
", with birthday " & Nz(!DBDOB, "Unknown") & ". The record you are importing has a birthday on " & Nz(!ImportDOB, "Unknown") & vbCrLf & _
"Please choose your course of action:"
' MsgBox strMsg
Select Case MessageForm(strMsg, 240, "W A R N I N G")
Case Is = 1
' MsgBox "You want to import it anyway"
'Leave ImportInstruction blank
'Do nothing: Set it to blank in case it was not previously blank, likewise the perID
intDupID = rstDup!Id
'STORED PROCEDURE
Set cmd = New ADODB.Command
cmd.ActiveConnection = con
cmd.CommandType = adCmdStoredProc
'This tells Access the name of the Stored Procedure
cmd.CommandText = "evt_sp_UD_ImportTemp"
'This gives the stored procedure the relevant parameters
cmd.Parameters.Append cmd.CreateParameter("myperID", adInteger, adParamInput, , Null)
cmd.Parameters.Append cmd.CreateParameter("MyID", adInteger, adParamInput, , intDupID)
cmd.Parameters.Append cmd.CreateParameter("IIID", adSmallInt, adParamInput, , Null)
cmd.Execute
Set cmd = Nothing
'ThrowawayRecordset rstUDImport