As usual, a bit of a strange problem with one of my Excel VBA macro's.
I use Excel as a database, with one worksheet storing a large amount of data.
I search the date using ADODB.
Everything run's fine on most PC's, but today, one of my colleagues encountered a problem which I cannot understand.
The issue is only seen on his computer. He sent me the file, I failed to reproduce the issue on my PC. Additionally, other colleagues using the same source code do not have any issues.
The issue:
One of the fields (column) in the database is the "case status". When we change the status of a case from 'Open' to 'Closed' and then query all records with status 'Open', the changed case still shows up in the resulting record set. When I verify the status in the worksheet which is used as the query source, I can see that the status is set to 'Closed' but ADODB still find it as 'Open'.
As I mentioned, this happens only on 1 PC, so it cannot be the code. Could this be a particular library and if so, which one. I compared the used libraries via a teamviewer session on his and my PC and they are all identical.
I am lost.
This is the code I use
Public Sub OpenDB()
If cnn.state = adStateOpen Then cnn.Close
cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
cnn.Open
End Sub
Public Sub closeRS()
If rs.state = adStateOpen Then rs.Close
rs.CursorLocation = adUseClient
End Sub
...
If PRODUCTname <> "" Or PIRstate <> "" Or cmbPIRnr.Text <> "" Then
'now extract data
closeRS
OpenDB
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
'Now putting the data on the sheet
ActiveCell.CopyFromRecordset rs
Else
MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
Exit Sub
End If
...
Related
So i have this code in two different workbooks, two different files. They are even in the same folder in the same computer.
strFile = "Z:\service\climatizacion.mdb"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strFile
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
strSQL = "SELECT codigorep, cantidad, precio, descripcion FROM cotizacion WHERE codigorep = " & lngInput & ";"
Set rs = CreateObject("ADODB.RECORDSET")
rs.Open Source:=strSQL, ActiveConnection:=cn, CursorType:=adOpenDynamic, LockType:=adLockOptimistic
In one of the workbooks it works perfect, it selects all the data i need from the database.
On the other it gives me the Runtime error 3001 (The application is using arguments that are of the wrong type, are out of acceptable range, or are in conflict with one another) when I try to open the recordset.
I figured through this code that the connection was the problem (I may be wrong)
If cn.State = adStateOpen Then
MsgBox "connected"
Else
MsgBox "not connected"
End If
I cannot find the difference between these workbooks that can make this connection or the entire code work or make it stop working.
All the variables are declared, the tables exist, i can open them through access with no problems, the database is located on a pc on my local network.
The database is an mdb file, from access 97. And i'm running this on excel 2003, both workbooks, and both were created by me with the same excel 2003.
Thank you in advance for taking the time to read this :D
I am having a frustrating issue with late binding to MS Access from Excel VBA to execute a DML statement like Insert or Update. All of the data I use in vba comes from user defined Classes. I can query just fine but writing to the DB gets different errors each time I try a different way to do the same thing. Below are some links to the same/similar issues, however each is slightly out of context and therefore I could not get passed my problem.
Microsoft.ACE.OLEDB.12.0 Current Recordset does not support updating error received when trying to update access
Operation must use an Updateable Query / SQL - VBA
Update an excel sheet using VBA/ADO
Operation must use an updatable query. (Error 3073) Microsoft Access
https://msdn.microsoft.com/en-us/library/bb220954%28v=office.12%29.aspx?f=255&MSPPError=-2147217396
http://www.access-programmers.co.uk/forums/showthread.php?t=225063
My end goal is to simply execute a DML string statement and it has to use late binding. Mainly I get the 3251 error saying my connection is 'Read Only' or a missing ISAM when I add ReadOnly=0 to the connection string. Fyi, getProjectFile just returns a path to a file starting from the parent folder of my project. I am pretty sure I can just use the connDB.Execute so I only need SQL Insert, I don't want to query first because the queries will get fat quick. I also think something might be wrong with the enum params because the ExecuteOptions want bitmasks instead of just a Long and I don't really know how to do that. From most of my research, I kept getting referred to the LockType and/or cursor not being right. For my environment; Windows 8.1 64bit, MS Office 2010 32bit(required). Does anyone see what is wrong here?
Sub ADO_Tester()
Dim strSQL, strFile, strConnection As String
Dim connDB As Object
'late bind to the ADODB library and get a connection object
Set connDB = CreateObject("ADODB.Connection")
'Connect to the DB
strFile = Application.ActiveWorkbook.Path & "\" & "PortfolioDB.accdb"
strConnection = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strFile & ";"
connDB.Open strConnection
'insert statement for a test record
strSQL = "INSERT INTO underlying_symbol (symbol) VALUES ('xyz')"
'execute the
connDB.Execute strSQL, , 2, 1 + 128
'clear the object
connDB.Close
Set connDB = Nothing
End Sub
Edit:
Early binding:
connDB.Execute strSQL, , adCmdText + adExecuteNoRecords
Late Binding: How to enter the value for adExecuteNoRecords? On msdn it is 0x80 and another post says &H0001,either way it gives a syntax error. It says enter a bitmask for this enum value.
connDB.Execute strSQL, , 1 + 0x80
Edit: Now the correct way -
adExecuteNoRecords (the ADO enum value) = 0x80 (a binary value) = 128 (a decimal value)
connDB.Execute strSQL, , 1 + 128
Edit: Now the issue gets even deeper. When I execute the code in a test spreadsheet into a test database, it works. When I copy and paste into the actual project spreadsheet and point to actual project db, I get the error: operation must use an updateable query . . . again. Same db name, same dml, same table name. The only difference is the actual DB is a product of a split to separate it from the forms and code in Access. Could this have changed some setting to make it read only?
Edit: It just gets deeper and deeper. The issue causing it not to work in the project db is because I have some Excel Tables querying the db. I made these through the Excel UI, Ribbon -> External Data -> Access -> etc. . . It has now become obvious these are causing me to be unable to insert DML because they are probably set to read only. How can I change the tables connections permissions? Is there another way I could be making these tables so that I can provide the connection? How to get Tables to be friendly with DML in VBA?
This worked for me:
Option Explicit
Private Const acCmdText As Integer = 1
Sub ADO_Tester()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim strFile As String
'Dim adoRecSet As Object
Dim connDB As Object
'late bind to the ADODB library and get a connection object
Set connDB = CreateObject("ADODB.Connection")
'Connect to the DB
strFile = getProjectFile("core", "PortfolioDB.accdb")
connDB.Open connectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strFile & ";"
'If State = 1, db connection is okay.
MsgBox "ADO Connection State is " & connDB.State & "."
'SQL to get the whole [underlying_symbol] table
'strSQL = "underlying_symbol" 'if options 2
'strSQL = "SELECT * FROM underlying_symbol" 'if options 1
strSQL = "INSERT INTO underlying_symbol (symbol) VALUES ('xyz')"
'late bind to adodb and get recordset object
'Set adoRecSet = CreateObject("ADODB.Recordset")
'&H0001 = bitmask for aCmdText
connDB.Execute strSQL, , acCmdText
'With adoRecSet
' .Open Source:=strSQL, _
' ActiveConnection:=connDB, _
' CursorType:=1, _
' LockType:=3, _
' Options:=&H1
'.AddNew
'.fields("symbol") = "XYZ"
'.Update
'End With
'------------------
'close the objects
'adoRecSet.Close
connDB.Close
'destroy the variables
'Set adoRecSet = Nothing
Set connDB = Nothing
ExitMe:
Exit Sub
ErrorHandler:
MsgBox Err.Number & ": " & Err.Description
GoTo ExitMe
End Sub
Added some error handling, a constant that defines acCmdText (Why just not add a reference to ADO library? Up to you, though.), and a message box to check the connection state to the database, as I can't test your getProjectFile function. Late binding doesn't seem to be the issue here, I think the key line is:
connDB.Execute strSQL, , 2, &H1
Can really say what's going on here as I've never done it like this (code doesn't even compile), but changing it to
connDB.Execute strSQL, , acCmdText
worked for me.
I have the below excel sheet that is set as shared and is being access by multiple users within the team:
Sheet http://im47.gulfup.com/xQTWqT.png
As the sheet is being updated with new records very often, I have set the below sharing options and that the sheet is being saved and the other users changes are being updated every five minutes (the minimum that you can set):
Options http://im47.gulfup.com/SBX4jf.png
The problem happens when 2 users try to update the database at the same time within the 5 minutes, then excel will prompt them that this cell already contains data and will offer to resolve the changes.
Is there any way to avoid this happening.
I have searched and come across Disconnected ADO Recordset, but I am not very clear on how they could aid in my scenario.
Any help will be highly appreciated.
Never mind I figured it out:
Create a user entry form in one workbook, and create another workbook for the storage of the data (lets call it Book1).
Next this is the code:
Private Sub CommandButton1_Click()
' Add the ActiveX Object Library
' Tools ---> References ---> Microsoft ActiveX Data Objects 2.5 Library
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=C:\Users\Name\Downloads\Book1.xls;" & _
"Extended Properties=Excel 8.0;"
.Open
End With
strSQL = "INSERT INTO [Sheet1$](Name, Age, Nationality, Amount) values('" & UserForm1.TextBox1.Value & "','" & UserForm1.TextBox2.Value & "','" & UserForm1.TextBox3.Value & "','" & UserForm1.TextBox4.Value & "')"
cn.Execute strSQL
End Sub
I have an access 2010 database that was an access 2007 database. It uses a 2nd database on a network server.
I am developing in windows 7 32bit.
Below is the code I have inherited...
The problem I am having is that while the dataset binds to the combobox (Combo96) just fine for me in 'development mode' and in 'run mode' and it also works ok another windows 7 32bit machine and yet another windows 7 64bit machine. It refuses to work on one windows 32bit machine.
I'm guessing its a problem with references? All I know about the target (failing) machine is that is windows 7, it has the access 2010 runtime, it may have access 2007 or access 2007 runtime, I don't really have a way to find out.
I added the code at the bottom that takes the dataset and copies it to the combobox. This works just fine on all machines but takes considerably longer.
Any Ideas why the dataset wont bind to combo96 on some machines?
On Error GoTo err_hand
Dim SearchStr As String
Dim oRec As ADODB.Recordset
Combo96.RowSource = ""
txtSearch.SetFocus
SearchStr = Trim(txtSearch.text)
Set oRec = New ADODB.Recordset ' [Client Number],
strQuery = "SELECT replace(replace([Company],"","","""" ),"":"","""") as [Companys] FROM tblClient where company <> '' ORDER BY [Company] "
oRec.Open strQuery, Load_ribbon.get_Connection, adOpenKeyset, adLockOptimistic
Me.Combo96.RowSourceType = "Table/Query"
Set Me.Combo96.Recordset = oRec
oRec.Close
err_endit:
Set oRec = noting
Exit Sub
err_hand:
Call sendReport.SendErrorDetail("CMP-0701-" & Erl, "Can't Read [Clients] Data SRC-" & SearchStr & "-" & Err.Description & "-" & Err.Number)
' Here comes some Cheese!!!!
On Error GoTo Skippy
' Bounding probably failed Try manual
If Not (oRec Is Nothing) Then
If oRec.RecordCount > 0 Then
If oRec.RecordCount > 1000 Then
MsgBox ("Too amany records found please be more specific")
Else
Me.Combo96.RowSourceType = "Value List"
oRec.MoveFirst
Do While Not RS.EOF
Me.Combo96.AddItem RS![Company]
oRec.MoveNext
Loop
End If
End If
End If
Resume err_endit
Skippy:
MsgBox ("Run-Time Error CMP-0702-" & Erl & " Can't Read [Clients] Data")
Call sendReport.SendErrorDetail("CMP-0702-" & Erl, "Can't Read [Clients] Data SRC-" & SearchStr & "-" & Err.Description & "-" & Err.Number)
Resume err_endit
Consider using the SQL query in the Combo96.RowSource instead of Combo96.Recordset property. If tblClient is available locally after connection, in VBA set the combobox's rowsource to
SELECT replace(replace([Company],"","","""" ),"":"","""") as [Companys] FROM tblClient where company <> '' ORDER BY [Company].
Apparently, there are caveats with how to open an ADODB Recordset to assign it to a combobox/listbox. See this forum thread: Populate Combo box using recordset
It turned out this is a problem with the Access runtime. Because both 2007 and 2010 were installed it is necessary to choose which one Access should run under.
I have several excel files that are used for entering data. Files are identical in functionality, one for each service center of ours. In the form there is button that launches a macro which transforms data to table format on another sheet which is then later uploaded to Access db.
Everything worked fine on my own computer. Adding new rows, updating existing rows and deleting existing roles. I had used early binding which lead to problems when I moved files to our network drive. I managed to convert files to late binding but then other problems arose.
Most of the time, uploading to Access isn't working, especially when multiple users try to do stuff at the same time. Most common error code is that I am not using updateable query or that this method doesn't support backwards scrolling. I sorry for not reporting actual error codes, but I can't replicate them at the moment.
My connection code is as follows, it is bit of a mix of copy paste code from different examples.
Opening the connection and other prestuff
Sub excel2access()
Const adUseClient = 3
Const adUseServer = 2
Const adLockOptimistic = 3
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Dim oConn As Object
Dim cmd As Object
Dim rs As Object
Dim r As Long
Dim criteria As String
Dim Rng As Range
Set oConn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source= '" & Range("dbpath").Value & "\" & Range("dbfile").Value & "' ;"
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "Select * from need_rows WHERE service_center = '" & Range("scenter_name").Value & "'", oConn
r = 2 ' the start row in the worksheet
Sheets("data").Select
This following bit looks through data in excel sheet and tries to find match from recordset found for that service center. If match is not found new record is created and if match is found the old record is updated.
Do While Len(Range("A" & r).Formula) > 0
With rs
criteria = Range("D" & r).Value
.Find "identifier='" & criteria & "'"
If (.EOF = True) Or (.BOF = True) Then
.AddNew ' create a new record
.Fields("service_center") = Range("scenter_name").Value
.Fields("product_id") = Range("A" & r).Value
.Fields("quantity") = Range("B" & r).Value
.Fields("use_date") = Range("C" & r).Value
.Fields("identifier") = Range("D" & r).Value
.Fields("file_type") = Range("file_type").Value
.Fields("use_type") = Range("E" & r).Value
.Fields("updated_at") = Now
.Update
Else
If .Fields("quantity") <> Range("B" & r).Value Then
.Fields("quantity") = Range("B" & r).Value
.Fields("updated_at") = Now
.Update ' stores the new record
End If
End If
.MoveFirst
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
Set oConn = Nothing
MsgBox "Confirmation message"
End Sub
Edit: Based on link by barrowc I changed cursor type to adOpenStatic. I made a test with several users trying to upload data at the same time and everything worked perfectly. Until one user stayed in the file and spent quite a while editing data there and then tried to upload data to db and got following error message: https://dl.dropbox.com/u/3815482/vba_error.jpg
Again, I am back where I started from.
Also, I am open to feedback on my code in general as well.
I am using Office 2010.
Am I doing it wrong? All help is appreciated.
You are going to have a lot of issues with the database being locked by other users. This is for several reasons:
From what I can see you are not handling errors. Therefore if your script errors half way through the connection will be left open thus causing lock problems.
By the looks of this, the macros could potentially keep the connection open for a decent amount of time (assuming no errors).
Having created a lot of macros connecting to an MS Access database I can tell you straight up. You are going to have a lot of connection issues where the database is being locked by spreadsheets that someone has left open all day/night due to things such as not handling unexpected errors (the connection never closes).
Even once you fix the problems all you need is ONE person to be using the spreadsheet with the old code and they will continue to lock the database.
One massive problem is that if someone connects to the database when its already open by someone else I believe they inherit the connection type of the already opened database resulting in a daisy chain of write locks. You then need to make sure all connections are severed in order to reset the connection.
You have also not shown us how the data is put into the spreadsheet in the first place. Perhaps you are not correctly closing the connection and that could potentially be the reason why sometimes the database is locked.
There are many different things you could try to get around this:
Easiest would be to use MS Access Front End + MS Access Back End.
Instead of pressing this button and uploading the data through connection strings you could make it save the file in a folder which would then be processed by an ms access database that is sitting there watching the folder. This would mean that you upload script would be written in MS Access and just be processing the files. Wouldn't be as instantaneous as your current approach but all write connections would be coming from the same machine/user in this circumstance.
Persist with the current method: eventually you may get it to a stable state but it will be a lot of frustration and effort as determining the reason for a lock may not always be easy. You could at least look at who has the file locked at the time and work from there but as mentioned earlier they may not have been the cause of the lock. They may have just inherited the lock type.
Personally I like to use MS Excel to display MS Access data for users, but avoid like a plague getting it to update MS Access. However if I was to do this I would do it through the use of oConn.Execute commands not opening a recordset, comparing and slowing pushing as that would keep the connection open too long.
Sorry for the wall of text. Hope this information helps.
sounds to me like Jet isn't reliable enough for your environment. I frequently use SQL Server / Access Data Projects to consolidate information from multiple spreadsheets into a single database backend that doesn't barf when you add a half dozen users.
You could also try using action queries.
First I would try to update using (you may need to format the now value)
dim count as long
oConn.Execute "UPDATE need_rows SET quantity = " & Range("B" & r).Value & ", updated_at = #" & Now & "# WHERE service_center = '" & Range("scenter_name").Value & "' AND identifier='" & Range("D" & r).Value & "' AND quantity <> " & Range("B" & r).Value", count
If count is zero then no row was updated, so either there was no row to update or the quantity hasn't changed. Either way we can try to INSERT, which will fail in the latter case, but without causing problems.
if count = 0 then
count = oConn.Execute "INSERT ...", count
if count = 0 then
' quantity has not changed, so nothing to do
else
' new record inserted
end if
else
' record updated
end if