VBA in Access 2010 - Run-time Error 430 - sql

I’m getting a Run-time error '430': Class does not support Automation or does not support expected interface" on this line of code Set Me.lstResults.Recordset = rs or this Set Me![frmM_SearchForDocumentsSubForm].Form.Recordset = rs. I am trying to get the ADO Recordset based on a SQL stored procedure to appear in an unbound Listbox or Subform of an Access form. I’m on Win 7 Machine using Access 2010 connecting to SQL Server 2008:
On_Click event:
Private Sub cmdRun_Click()
'On Error Resume Next
Dim strSQL As String
'Stored procedure + parameters called from form
strSQL = "Exec sqlsp_searchalltables " & Me.txtTables & _
", " & "'%" & Me.txtSearchTerm & "%'"
OpenMyRecordset rs, strSQL
'debug - view procedure
Me.lblQuery.Caption = strSQL
Me.Repaint
Set Me.lstResults.Recordset = rs
'or this
'Set Me![frmM_SearchForDocumentsSubForm].Form.Recordset = rs
End Sub
I found some solutions for this error on the web and tried all of them to no avail. Most suggested checking the references which I did and verified.
I am able to successfully connect to the SQL server and have the results display in both a Listbox and Subform when I use DAO Querydef and a passthrough query or if I use this .listbox method:
With Me.lstResults
Do
strItem = rs.Fields("CLIENT_ID").Value
.AddItem strItem
rs.MoveNext
Loop Until rs.EOF
End With
I would prefer not to use the DAO method because I found I need the coding flexibility of ADO especially with connecting to multiple Recordsets in SQL. Thoughts?
FYI: My OpenMyRecordset public function in Module:
Option Compare Database
Option Explicit
Global con As New ADODB.Connection
Global rs As ADODB.Recordset
Global NoRecords As Boolean
Public Enum rrCursorType
rrOpenDynamic = adOpenDynamic
rrOpenForwardOnly = adOpenForwardOnly
rrOpenKeyset = adOpenKeyset
rrOpenStatic = adOpenStatic
End Enum
Public Enum rrLockType
rrLockOptimistic = adLockOptimistic
rrLockReadOnly = adLockReadOnly
End Enum
Public Function OpenMyRecordset(rs As ADODB.Recordset, strSQL As String, Optional rrCursor As rrCursorType, _
Optional rrLock As rrLockType, Optional bolClientSide As Boolean) As ADODB.Recordset
If con.STATE = adStateClosed Then
con.ConnectionString = "ODBC;Driver={SQL Server};Server=mysqlsvr;DSN=RecordsMgmt_SQLDB;UID=XXX;Trusted_Connection=Yes;DATABASE=RecordsManagementDB;"
con.Open
End If
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = con
.CursorLocation = adUseClient
.CursorType = IIf((rrCursor = 0), adOpenDynamic, rrCursor)
.LockType = IIf((rrLock = 0), adLockOptimistic, rrLock)
.Open strSQL
If .EOF And .BOF Then
NoRecords = True
Exit Function
End If
End With
End Function

You definitely do not have to do the looping method to just to populate the listbox. I'm not familiar with the OpenMyRecordset command you used, but I suspect that something in its functionality is what is causing this error (i.e., it's not opening the recordset in a manner compatible with the listbox). This is how I connected to a local instance of SQL Server Express and was able to populate a listbox.
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
With cn
.ConnectionString = _
"Provider=SQLOLEDB;Data Source=localhost\SQLEXPRESS;" & _
"Initial Catalog=Northwind;Trusted_Connection=yes"
.Open
End With
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Source = "SELECT FirstName, LastName FROM Employees"
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
End With
Set Me.lstTest.Recordset = rs
Set rs = Nothing
Set cn = Nothing
You will have to make sure that you have the Microsoft ActiveX Data Objects Library reference enabled in your project.

Related

Is it possible to pass a parameter from MS Access to a SQL Server stored procedure and display the output in a datasheet form?

Users in MS Access enter values in a field that is passed as a parameter to a stored procedure in a SQL Server database. The stored procedure will return a result set with two columns. I would like to display that result set in a datasheet form. The code below almost does that, but will only display the final row of the result set. I confirmed that the stored procedure is being passed to the db correctly and that the test values I'm using should return 4 rows. The code in comments are a few of the many things that I have tried that didn't work.
Private Sub btnBulkLink_Click()
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
With cmd
.CommandType = adCmdStoredProc
.ActiveConnection = "Driver=SQL Server Native Client 11.0;Server=xxxxxxxxxxxxxxxxx;Database=xxxxx;Trusted_Connection=Yes"
.CommandText = "dbo.usp_FindResolutionsLinkedToServices"
.CommandTimeout = 180
.NamedParameters = True
End With
cmd.Parameters.Append cmd.CreateParameter("#PprsRefINP", adLongVarChar, adParamInput, Len(txtBulkLink.Value), txtBulkLink.Value)
Set rst = cmd.Execute
DoCmd.OpenForm FormName:="ServiceResolutionLink", View:=acFormDS, DataMode:=acFormReadOnly, WindowMode:=acHidden
' Set Forms!ServiceResolutionLink.Recordset = rst
With rst
Do While Not .EOF
Forms("ServiceResolutionLink").txtPprsRef = rst!PprsRef
Forms("ServiceResolutionLink").txtSubmissionId = rst!SubmissionId
.MoveNext
Loop
End With
' Forms("ServiceResolutionLink").txtPprsRef = rst!PprsRef
' Forms("ServiceResolutionLink").txtSubmissionId = rst!SubmissionId
' Forms("ServiceResolutionLink").Visible = True
DoCmd.OpenForm FormName:="ServiceResolutionLink", View:=acFormDS
rst.Close
End Sub
Ok, we assume you setup a pass-though query. (and it set with returns records = true).
And if your datasheet is a REAL sub form (setup as datasheet - not a table).
Then this code will work:
Private Sub Command2_Click()
With CurrentDb.QueryDefs("qryPassR")
.SQL = "exec dbo.GetHotels2 #City = '" & "Banff" & "'"
End With
Me.MyDataSheet.Form.RecordSource = "qryPassR"
End Sub
And if you are using a real datasheet (form that does not exist), then you can have the form set to
Query.PassR
The trick (or challenge) then becomes to have the form NOT load until such time you setup the query with the correct stored procedure call.
I was in the midst of testing suggestions from others when my boss figured this out. Here is our final code:
Private Sub Form_Load()
Dim rst As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim strPPRSRef As String
Dim cn As New ADODB.Connection
With cn
.Provider = "sqloledb"
cn.Properties("Data Source").Value = "[server]"
cn.Properties("Initial Catalog").Value = "[db]"
cn.CursorLocation = adUseClient
' Windows authentication.
cn.Properties("Integrated Security").Value = "SSPI"
' .CursorLocation = adUseClient
End With
cn.Open
With cmd
.CommandType = adCmdStoredProc
.ActiveConnection = cn
.CommandText = "dbo.usp_FindResolutionsLinkedToServices"
.CommandTimeout = 180
.NamedParameters = True
End With
strPPRSRef = Forms("Resolution_Tracker").txtBulkLink.Value
cmd.Parameters.Append cmd.CreateParameter("#PprsRefINP", adLongVarChar, adParamInput, Len(strPPRSRef), strPPRSRef)
With rst
.CursorType = adOpenStatic
.CursorLocation = adUseClient
End With
Set rst = cmd.Execute
Set Me.Recordset = rst
rst.Close
Set rst = Nothing
cn.Close
Set cn = Nothing
End Sub

If i create a disconnected ADO recordset from scratch in VBA how do i set the base table information for UpdateBatch?

I have been using disconnected recordsets for a few weeks now, typically retrieving data from SQL Server, disconnecting the rs and filtering/formatting in VBA. Now i'm trying to do the reverse and create a new ADO recordset from scratch, and then connect it to my database and use UpdateBatch to insert the recordset into the database without using a loop. I have a fully populated recordset at this point, hooked it back up to my connection string, and try UpdateBatch. Understandably, it has no information at this point about what table I'm trying to update (only Data Source and Initial Catalog via the connection string). Is there a recordset property that I use to provide the table in question? Additionally, the table I'm trying to import into has a GUID field (first field) that I have left blank on purpose in my disconnected recordset assuming that upon import, SQL Server would assign this GUID/primary key automatically.
The specific error I'm getting after "rs.UpdateBatch" is
Run-time error '-2147467259 (80004005)'"
Insufficient base table information for updating or refreshing.
I know I could use a loop and a SQL command "INSERT INTO ...". I'd like to use a recordset object though since those provide much more functionality as a container for data. One thing I haven't tried is to first retrieve a recordset from the table in question, then clear it and re-populate it with the new data so that the recordset itself retains all of the original database and table properties. If that's the only/best approach I can try that route too. I just wanted to see if it was possible to create an ADO recordset, populate it, and then insert it into a matching table of my choice.
dim rs as ADODB.Recordset
set rs = New ADODB.Recordset
With rs.Fields
.append "alias", adVarChar, 255
.append "textA", adVarChar, 255
.append ......
End With
rs.Open
rs.AddNew Array(0, 1, 2, ..., n), Array(val0, val1, val2, ..., valn)
rs.Update
call importRS(rs)
rs.close
set rs = nothing
After rs.update above some recordsets may need to go to a database, other recordset objects are just used to expedite filtering and sorting so I just use them as a convenient container and they'd never go to importRS()
However, IF I need to send the disconnected recordset to a database, i'd like to just pass the recordset object to another function that serves the purpose of opening the connection, sending the update, and closing the connection. The code below would serve that purpose which is why i'd like to wait to establish a connection until this point, right at the end after my rs is populated.
sub importRS(byref rs as ADODB.Recordset)
dim cn as ADODB.Connection
set cn = New ADODB.Connection
cn.ConnectionString = strConnection 'my connection string variable'
cn.Open
rs.ActiveConnection = cn
rs.UpdateBatch '-------error message appears on this line
cn.close
set cn = nothing
You can get the data, (wherever it may be) into an array and add to the recordset using a loop. Then then when the loop is finished, you do rs.updatebatch as follows:
Private Sub SaveToSQLSever()
Dim lngLastRow As Long
Dim arrySheet As Variant
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim strCn As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
strCn= "Provider=VersionOfSQL;User ID=*********;Password=*********;"
& _ "Data Source=ServerName;Initial Catalog=DataBaseName"
cn.Open strCn
On Error Goto exiting
'*********************************************************
'If the data is coming from a sheet
'Set to your Range
With Sheets("SheetName")
lngLastRow = .Range("A2").CurrentRegion.Rows _
(.Range("A2").CurrentRegion.Rows.Count).Row
arrySheet = .Range("A1:G" & lngLastRow).Value2
End With
'Else populate the array and pass it to this Sub
'*************************************************************
'Note the property parameters
'.Source = Table That you want to populate
With rs
.ActiveConnection = cn
.Source = "Select * from TableName"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open
End With
For i = LBound(arrySheet,1) To UBound(arrySheet,1)
rs.AddNew
For j = LBound(arrySheet,2) To UBound(arrySheet,2)
rs.Fields(j).Value = arrySheet(i,j)
Next j
rs.MoveNext
Next i
rs.UpdateBatch 'Updates the table with additions from the array
i = 0
'******************************************************************
'Note that you can also refer to the Field Names Explicitly Like So:
For i = LBound(arryData,1) To UBound(arryData,1)
With rs
.AddNew
.Fields("FieldName1").Value = arryData(i,1)
.Fields("FieldName2").Value = arryData(i,2)
.Fields("FieldName3").Value = arryData(i,3)
.Fields("FieldName4").Value = arryData(i,4)
.Fields("FieldName5").Value = arryData(i,5)
.Fields("FieldName6").Value = arryData(i,6)
.Fields("FieldName7").Value = arryData(i,7)
End With
Next i
rs.UpdateBatch
'******************************************************************
MsgBox "The data has successfully been saved to the SQL Server", _
vbInformation + vbOKOnly,"Alert: Upload Successful"
exiting:
If cn.State > 0 Then cn.Close
If rs.State > 0 Then rs.Close
Set cn = Nothing
Set rs = Nothing
End Sub
Edit: As per OP's request to pass an existing recordset to a SQL table, below should do so:
Private Sub SendRcrdsetToSQL(ByRef rsIn As ADODB.Recordset)
Dim arrySheet As Variant
Dim rsSQL As ADODB.Recordset
Dim cn As ADODB.Connection
Dim strCn As String
Set cn = New ADODB.Connection
strCn= "Provider=VersionOfSQL;User ID=*********;Password=*********;"
& _ "Data Source=ServerName;Initial Catalog=DataBaseName"
cn.Open strCn
On Error Goto exiting
Set rsSQL = New ADODB.Recordset
With rsSQL
.ActiveConnection = cn
.Source = "Select * from TableName"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.Open
End With
'disconnect the recordset and close the connection
Set rsSQL.ActiveConnection = Nothing
cn.Close
Set cn = Nothing
rsIn.MoveFirst
rsSQL.MoveLast
'Add the records from the passed recordset to the SQL recordset
Do While Not rsIn.EOF
With rsSQL
.AddNew
.Fields("FieldName1").Value = rsIn.Fields("FieldName1").Value
.Fields("FieldName2").Value = rsIn.Fields("FieldName2").Value
.Fields("FieldName3").Value = rsIn.Fields("FieldName3").Value
.Fields("FieldName4").Value = rsIn.Fields("FieldName4").Value
.Fields("FieldName5").Value = rsIn.Fields("FieldName5").Value
.Fields("FieldName6").Value = rsIn.Fields("FieldName6").Value
.Fields("FieldName7").Value = rsIn.Fields("FieldName7").Value
End With
rsIn.MoveNext
Loop
rsSQL.UpdateBatch
MsgBox "The data has successfully been saved to the SQL Server", _
vbInformation + vbOKOnly,"Alert: Upload Successful"
exiting:
If cn.State > 0 Then cn.Close
If rsIn.State > 0 Then rsIn.Close
If rsSQL.State > 0 Then rsSQL.Close
Set cn = Nothing
Set rsIn = Nothing
Set rsSQL = Nothing
End Sub
The only way I was able to get this to work was by running a query to build the structure of my Recordset. So your code becomes something like this:
Private Sub Command1_Click()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "<your connection string>"
cn.CursorLocation = adUseClient
cn.Open
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.Open "select * from states where 1<>1", , adOpenStatic, adLockBatchOptimistic
rs.AddNew Array("Abbrev", "Name", "Region", "SchoolDataDirect"), Array("TN", "TestName", "MyRegion", 1)
Set rs.ActiveConnection = Nothing
cn.Close
ImportRS rs
End Sub
Private Sub ImportRS(ByRef rs As ADODB.Recordset)
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "<your connection string>"
cn.CursorLocation = adUseClient
cn.Open
Set rs.ActiveConnection = cn
rs.UpdateBatch
Set rs.ActiveConnection = Nothing
cn.Close
End Sub

Connection String for MS Access Database incorrect

I am trying to extrapolate data from an MS Access 2007/2010 Database.
I have the following code in VBA but the connection string is incorrect. I have added the relevant REFERENCES libraries
Private Sub btnGetMsAccessData_Click()
Dim sConn As String
Dim oConn As ADODB.Connection
Dim oRs As ADODB.Recordset
Dim sSQL As String
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=\\MyNetworkPath\BP-MasterDashboard Source\BP_Planning_by_PT_dept_be.accdb;Mode=Read"
Set oConn = New ADODB.Connection ' Open a connection.
oConn.Open
sSQL = "SELECT * FROM Tbl_Start_Leaver" ' Make a query over the connection.
Set oRs = New ADODB.Recordset
oRs.Open sSQL, , adOpenStatic, adLockBatchOptimistic, adCmdText
MsgBox oRs.RecordCount
oConn.Close ' Close the connection.
Set oConn = Nothing
End Sub
It fails saying Unknown Application error on the oConn.Open line.
I have tried to link a Workbook to one of the tables and this works fine.
I then looked at the "Connection" and copied it into my code but still no joy.
Keeps saying :
Automation Error
Unexpected Error
Any ideas would be appreciated.
Thanks in advance.
While the connection string was incorrect, there were other issues as well. Such as, not assigning the connection String to the ADODB Connection object as well as others. Here is the updated code that I hope will get you operational
Private Sub btnGetMsAccessData_Click()
'Ensure you add a reference to Microsoft ADO Objects
Dim oConn As New ADODB.Connection
Dim oRs As New ADODB.Recordset
Dim sSQL As String: sSQL = "SELECT * FROM Tbl_Start_Leaver"
'Corrected Connection String from Thomas Inzina
Dim sConn As String: sConn = "Provider=Microsoft.ACE.OLEDB.12.0;UID=Admin;Data Source=" & _
"\\MyNetworkPath\BP-MasterDashboard Source\BP_Planning_by_PT_dept_be.accdb;Mode=Read"
With oConn
.ConnectionString = sConn ' You need to assign the connection string to the ADODB.Connection Object
.Open
End With
'Make sure the connection isn't open before opening the recordset
'You also need to specify which connection you want to use as the second parameter (this was missed)
If oRs.State <> adStateOpen Then oRs.Open sSQL, oConn, adOpenStatic, adLockBatchOptimistic, adCmdText
'Close Connection and RS
If oConn.State = adStateOpen Then oConn.Close
If oRs.State = adStateOpen Then oRs.Close
'Clean Up
Set oRs = Nothing
Set oConn = Nothing
End Sub

Runtime error '3705': opertion is not allowed when the object is open

'Redundancy checking function
Private Function Redundancy_Check(Sup_ID)
rs.Open "Select*from tblSupplier where Supplier_ID='" & Sup_ID & "'", cn, 3, 3
If rs.RecordCount > 0 Then
If Not (rs.BOF And rs.EOF) Then
iTerminate = True
End If
End If
Set rs = Nothing
End Function
Is there something wrong with my coding? I've checked the log and it states:
"Cannot load control usrGrid."
I'm using Visual Basic 6.0 + MS Access.
The run-time error 3705 occurs because only client-side ADO recordsets rs can be disconnected. It occurs when you attempt to disconnect a server-side ADO recordset. You need to set the CursorLocation property of the ADO Recordset to adUseClient. Assume that your ADODB.Connection variable is called cn, you need to add the following line before open the connection :
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient ' avoid error 3705
cn.Open "..."
Here's the complete example provided by Microsoft
Private Sub Command1_Click()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
'Place cn.CursorLocation = adUseClient here
cn.Open "Provider=SQLOLEDB;Data Source=<SQL Server>;Initial Catalog=pubs;User Id=<UID>;Password=<PWD>"
rs.Open "Select * from authors", cn, adOpenStatic, adLockBatchOptimistic
Set rs.ActiveConnection = Nothing
rs.Close
cn.Close
End Sub
See
PRB: Run-Time Error Message 3705
BOF, EOF, and Bookmark Properties Example (VB)
Another potential cause is that rs already has a recordset open. Because your code doesn't Dim and initialize rs inside of your method I'm assuming it's created as a module variable and it doesn't look like it's being closed.
Somewhere you need to call rs.Close before you can call rs.Open again. Add this before your rs.Open line and run your code.
If Not rs.State = adStateClosed Then
MsgBox "The recordset is already open"
End If

Access Recordset Yielding NAME?

I have an access database that connects to an SQL database via ADODB. The recordset for the access table view is set via the recordset property in the method below. This method is called from the Form_Load function for the form it is viewable in. The form is accessed via a tab on a main form.
Unfortunately, the recordset doesn't seem to be updating correctly between machines. On one machine (Access 2010) it loads up fine. On the second (Access 2010) it loads only the first line as Name?. Sometimes I can get it to load on the second machine if I open the form on it's own, then open the tab.
Any help would be appreciated. Thanks in advance!
Function LoadTblEmployeesADOtoForm()
Dim sqlStr As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim p As ADODB.Property
Const ConnStr = "PROVIDER=SQLOLEDB;Server=SERVER;Database=DB;User ID=ID;Password=PWD;"
Set cn = New ADODB.Connection
cn.Open ConnStr
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockPessimistic
'SELECT
sqlStr = "SELECT * FROM tblEmployees ORDER BY NetworkID"
Debug.Print sqlStr
.Source = sqlStr
Set .ActiveConnection = cn
.Properties("Preserve on Abort") = True
.Properties("Preserve on Commit") = True
End With
'cn.BeginTrans
rs.Open
Debug.Print rs.RecordCount
Dim temp As Integer
Set Form_frmManagetblEmployees.Recordset = rs
cn.Close
Set rs = Nothing
End Function
When the form is used as a subform, you cannot refer to:
Set Form_frmManagetblEmployees.Recordset = rs
However, Me will work for both a form and a subform, so:
Set Me.Recordset = rs