I want to lock just the current ADODB recordset (but not the page or the entire table) of a multi-user system developed in VBA/Access so that any other user that opens the same recordset cannot edit one recordset position already in edit mode in some other user computer. I want to avoid 2 o more users editing the same record position (eg: more than one user editing the registration of the same employee).
I tested the folowing code, unsuccessfully:
Private Sub Form_Load()
Dim dbcon As ADODB.Connection
Dim recrdst As ADODB.Recordset
Set recrdst = New ADODB.Recordset
recrdst.CursorType = adOpenKeyset
recrdst.LockType = adLockPessimistic
Set dbcon = New ADODB.Connection
dbcon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Família\Alex Borges\Companies\Imobiliária Halex Tiago\Estudos\Sistema Multi-Usuário\Servidor.mdb;"
recrdst.Open "SELECT * FROM tblDependentes", dbcon
Set Me.Recordset = recrdst
Set recrdst = Nothing
Set dbcon = Nothing
End Sub
I also tested the folowing code:
Private Sub Form_Load()
Dim dbcon As ADODB.Connection
Dim recrdst As ADODB.Recordset
Set dbcon = New ADODB.Connection
dbcon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Família\Alex Borges\Companies\Imobiliária Halex Tiago\Estudos\Sistema Multi-Usuário\Servidor.mdb;"
Set recrdst = New ADODB.Recordset
recrdst.ActiveConnection = dbcon
recrdst.CursorType = adOpenKeyset
recrdst.LockType = adLockPessimistic
recrdst.CursorLocation = adUseServer
recrdst.Open "SELECT * FROM tblDependentes", dbcon
Set Me.Recordset = recrdst
Set recrdst = Nothing
Set dbcon = Nothing
End Sub
my Access version is 2007. on Access/Options/Advanced, I changed the default record locking to "edited record".
thanks in advance.
Related
I have a userform in Access 2013 and I'd like to bind the controls to a ADO recordset when it is opened.
So far, I have the following code:
Private Sub UserForm_Activate()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
With cn
.CursorLocation = adUseClient
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source").Value = CurrentProject.FullName
.Properties("Mode").Value = adModeReadWrite
.Properties("Persist Security Info").Value = False
.Open
End With
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Source = "SELECT SerialNumber FROM SerialPlateData"
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
End With
'bind textbox to ado recordset at runtime
txtSerialNumber.ControlSource = rs.Fields("SerialNumber").Name
Set rs = Nothing
Set cn = Nothing
End Sub
I get an error at this line txtSerialNumber.ControlSource = rs.Fields("SerialNumber").Name
My aim is to bind the data retrieved from the recordset to the controls on the userform and when finished, I'll be updating the data table with any changes.
How am I best to fix this?
Thanks
I want to retrieve SharePoint list data using VB.NET.
Below Code is for reference:-
Public Const roleGuid As String = "{8405ef03-40fl-4fan-8dl2-cf7kll1b8c1e}"
Public Const sharepointSite As String = "https://mysharepointsite.com/sites/resourceview.aspx"
Public Function getSharepointList()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String
Dim sSql As String
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=1;RetrieveIds=Yes;" & _
"DATABASE=" & sharepointSite & ";" & _
"LIST=" & roleGuid & ";"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cn
.ConnectionString = sConn
.Open
End With
sSql = "SELECT * FROM [Student list] as [Student List];"
rs.Open sSql, cn, adOpenStatic, adLockOptimistic
ThisWorkbook.Worksheets("Sheet1").Range("A2").CopyFromRecordset rs
End Function
Below is error screenshot that gets popup
Any method or suggestion would be helpful.
I have found out a way to retrieve data from SharePoint list using vb.net
Public Function retrieveData()
'ADD FOLLOWING REFERENCES:-
'Microsoft ActiveX Data Objects 2.8 Library
'DECLARING CONNECTION AND RECORDSET OBJECTS, SQLQUERY STRING VARIABLE.
Dim cnt As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sqlQuery As String
'SETTING UP CONNECTION AND RECORDSET OBJECTS.
cnt = New ADODB.Connection
rs = New ADODB.Recordset
'HERE STUDENT LIST IS YOUR SHAREPOINT LIST NAME.
sqlQuery = "Select * from [Student List];"
'SETTING CONNECTION STRING TO CONNECTION OBJECT AND OPENING CONNECTION.
With cnt
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=2;RetrieveIds=Yes;DATABASE=https://mysharepointlist.com/sites/;LIST={Your List GUID};"
.Open()
End With
'OPENING RECORDSET.
rs.Open(sqlQuery, cnt, ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockReadOnly)
'FILLING DATATABLE WITH THE HELP OF DATA ADAPTER.
Dim myDa As OleDb.OleDbDataAdapter = New OleDb.OleDbDataAdapter
Dim myDs As DataTable = New DataTable
myDa.Fill(myDs, rs)
'FILLING DATAGRIDVIEW WITH DATATABLE AS DATASOURCE.
DataGridView1.Datasource = myDs
'CHECKS IF CONNECTION OBJECTS AND RECORDSET OBJECT IS IN OPEN STATE IF YES THEN IT WILL CLOSE AND DEREFERENCE THEM.
If CBool(rs.State And ADODB.ObjectStateEnum.adStateOpen) = True Then rs.Close()
rs = Nothing
If CBool(cnt.State And ADODB.ObjectStateEnum.adStateOpen) = True Then cnt.Close()
cnt = Nothing
End Function
I have a problem where I can't get a 'msg box' that tells me files that I have browsed match with files in the database. I use an SQL Server database and I have already inserted data that matches with the files that I am browsing. This is my code:
Private Sub CmdUp_Click()
db
End Sub
Public Sub db()
Dim DBCon As ADODB.Connection
Dim Cmd As ADODB.Command
Dim Rs As ADODB.Recordset
Dim strName As String
Dim file As String
file = Text1.Text
Set DBCon = New ADODB.Connection
DBCon.CursorLocation = adUseClient
DBCon.Open "Driver={MySQL ODBC 3.51 Driver};Server=localhost;Port=3306;Database=mforce; User=root;Password=;Option=3;"
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = DBCon
Cmd.CommandType = adCmdText
Cmd.CommandText = "SELECT Sample FROM static WHERE ID = 1"
Set Rs = Cmd.Execute
Do While Not Rs.EOF
Rs.MoveNext
Loop
If Form1.Text1.Text = strName Then
MsgBox " sample match"
End If
DBCon.Close
'Delete all references
Set Rs = Nothing
Set Cmd = Nothing
Set DBCon = Nothing
End Sub
How to change the code below to prevent what you see in the screenshot.
I am running a macro with the following code
Dim conn As ADODB.Connection
Dim rec1 As ADODB.Recordset
Dim thisSql As String
Set conn = New ADODB.Connection
Dim sConn As String
sConn = "Provider=SQLOLEDB;Trusted_Connection=Yes;Server=xyz;Database=xyz;UID=xyz;PWD=xyz"
conn.Open sConn
' this is creating multiple connections.
Set rec1 = New ADODB.Recordset
rec1.Open thisSql, conn
which runs a SQL Server query (which is around 20 lines long and contains 4 joins). Everything is fine except for the fact that after a couple times of running it my DB admin says that my query is loading up the DB too much.
Now, my query could be causing the problem, or it could be that Excel is starting to run multiple connections at once. Some evidence for this is the screenshot below and the fact that the load on the database appears to increase with time.
How do I establish a DB connection without constantly creating new connections?
Has anyone had similar problems working with Excel DB macros?
UPDATE
While the answers below were very useful (especially for someone starting out in VBA), it seems that the main reason my query was taking up load was a combination of multiple connections and having overlooked a line in my code:
With Sheets("FVols").QueryTables.Add(Connection:=rec1, Destination:=Sheets("FVols").Range("A1"))
.name = "data"
.FieldNames = True
.Refresh BackgroundQuery:=True <<<<<<<<<<<<<<<<<<<<<<<-----
End With
You only need to open the connection once. That literally means you can execute multiple queries on that one active connection. You must close the connection and free the reference (specially with ADODB) to avoid running into collisions and other connection related problems.
If you know the queries you are going to be executing you can create an array (or collection) and add queries to the queue.
While you already have an open connection to work with you can keep executing queries.
Scan through code there is not much difference between yours and mine so you should be able to see what is going on and where. Please, ask questions in the comments if anything is unclear
Sub DbConnection()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConn As String
strConn = "Driver={SQL Server};Server=; Database=; UID=; PWD="
cn.Open strConn
Dim queryArr, i
queryArr = Array("SELECT * FROM [MyTable]", "SELECT * FROM [MyOtherTable]")
For i = LBound(queryArr) To UBound(queryArr)
ExecuteQuery queryArr(i), cn, rs
Next i
cn.Close
Set cn = Nothing
End Sub
Private Sub ExecuteQuery(query As Variant, ByRef cn As ADODB.Connection, ByRef rs As ADODB.Recordset)
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cn
.Open CStr(query)
Sheets(1).Range("A1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
End Sub
Now, you only need to execute the DBConnection() once and all the queries you listed in the array will be executed.
Alternatively, if your queries are created at run-time you can pass it to the DbConnection() as a parameter.
Sub DbConnection(queryQueue As Collection)
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConn As String
strConn = "Driver={SQL Server};Server=HELIUM\PRI; Database=sourcedata; UID=tabula; PWD=Tabula123!"
cn.Open strConn
For i = 1 To queryQueue.Count
ExecuteQuery queryQueue.Item(i), cn, rs
Next i
cn.Close
Set cn = Nothing
End Sub
Private Sub ExecuteQuery(query As Variant, ByRef cn As ADODB.Connection, ByRef rs As ADODB.Recordset)
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cn
.Open CStr(query)
Sheets(1).Range("A1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
End Sub
Update:
You can declare your connection as a Global Variable. Now you can run the DBConnection() as many times as you like and you will not be creating a new connection each time. Instead you will be using the global connection object.
Option Explicit
Public cn As ADODB.Connection
Sub DbConnection()
Set cn = New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConn As String
strConn = "Driver={SQL Server};Server=; Database=; UID=; PWD="
cn.Open strConn
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cn
.Open "SELECT * FROM [MyTable]"
Sheets(1).Range("A1").CopyFromRecordset rs
.Close
End With
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Are you releasing the connection variable when you've finished with it? i.e.
Set rec1 = Nothing
The connection won't close fully if not.
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