Microsoft Access Query is Corrupt after latest patch [duplicate] - vba

Since installing the windows update for Office 2010 resolving KB 4484127 I get an error while executing queries which contain a WHERE clause.
For example executing this query:
DoCmd.RunSQL "update users set uname= 'bob' where usercode=1"
Results in this error:
Error number = 3340 Query ' ' is corrupt
The update in question is currently still installed:
How can I successfully run my queries? Should I just uninstall this update?

Summary
This is a known bug caused by the Office updates released on November 12, 2019. The bug affects all versions of Access currently supported by Microsoft (from Access 2010 to 365).
This bug has been fixed.
If you use a C2R (Click-to-Run) version of Office, use "Update now":
Access 2010 C2R: Fixed in Build 7243.5000
Access 2013 C2R: Fixed in Build 5197.1000
Access 2016 C2R: Fixed in Build 12130.20390
Access 2019 (v1910): Fixed in Build 12130.20390
Access 2019 (Volume License): Fixed in Build 10353.20037
Office 365 Monthly Channel: Fixed in Build 12130.20390
Office 365 Semi-Annual: Fixed in Build 11328.20480
Office 365 Semi-Annual Extended: Fixed in Build 10730.20422
Office 365 Semi-Annual Targeted: Fixed in Build 11929.20494
If you use an MSI version of Office, install the update matching your Office version. All of these patches have been released on Microsoft Update, so installing all pending Windows Updates should suffice:
Access 2010 MSI: Fixed in KB4484193
Access 2013 MSI: Fixed in KB4484186
Access 2016 MSI: Fixed in KB4484180
Example
Here is a minimal repro example:
Create a new Access database.
Create a new, empty table "Table1" with the default ID field and a Long Integer field "myint".
Execute the following code in the VBA editor's Immediate Window:
CurrentDb.Execute "UPDATE Table1 SET myint = 1 WHERE myint = 1"
Expected result: The statement successfully finishes.
Actual result with one of the buggy updates installed: Run-time error 3340 occurs ("Query '' is corrupt").
Related links:
MSDN forum thread
Official Microsoft page for this bug

Simplest Solution
For my users, waiting nearly a month till December 10 for a fix release from Microsoft is not an option. Nor is uninstalling the offending Microsoft update across several government locked down workstations.
I need to apply a workaround, but am not exactly thrilled with what Microsoft suggested - creating and substituting a query for each table.
The solution is to replace the Table name with a simple (SELECT * FROM Table) query directly in the UPDATE command. This does not require creating and saving a ton of additional queries, tables, or functions.
EXAMPLE:
Before:
UPDATE Table1 SET Field1 = "x" WHERE (Field2=1);
After:
UPDATE (SELECT * FROM Table1) SET Field1 = "x" WHERE (Field2=1);
That should be much easier to implement across several databases and applications (and later rollback).

This is not a Windows update problem, but a problem that was introduced with the November Patch Tuesday Office release. A change to fix a security vulnerability causes some legitimate queries to be reported as corrupt.
Because the change was a security fix, it impacts ALL builds of Office, including 2010, 2013, 2016, 2019, and O365.
The bug has been fixed in all channels, but the timing of delivery will depend on what channel you are on.
For 2010, 2013, and 2016 MSI, and 2019 Volume License builds, and the O365 Semi-annual channel, the fix will be in the December Patch Tuesday build, Dec 10.
For O365, Monthly Channel, and Insiders, this will be fixed when the October fork is released, currently planned for Nov 24.
For the Semi-Annual channel, the bug was introduced in 11328.20468, which was released Nov 12, but doesn’t roll out to everyone all at once.
If you can, you might want to hold off on updating until Dec 10.
The issue occurs for update queries against a single table with a criteria specified (so other types of queries shouldn’t be impacted, nor any query that updates all rows of a table, nor a query that updates the result set of another query).
Given that, the simplest workaround in most cases is to change the update query to update another query that selects everything from the table, rather than updating the query directly.
I.e., if you have a query like:
UPDATE Table1 SET Table1.Field1 = "x" WHERE ([Table1].[Field2]=1);
Then, create a new query (Query1) defined as:
Select * from Table1;
and update your original query to:
UPDATE Query1 SET Query1.Field1 = "x" WHERE ([Query1].[Field2]=1);
Official page: Access error: "Query is corrupt"

To temporarily resolve this issue depends on the Access version in use:
Access 2010 Uninstall update KB4484127
Access 2013 Uninstall update KB4484119
Access 2016 Uninstall update KB4484113
Access 2019 IF REQUIRED (tbc). Downgrade from Version 1808 (Build 10352.20042) to Version 1808 (Build 10351.20054)
Office 365 ProPlus Downgrade from Version 1910 (Build 12130.20344) to a previous build, see https://support.microsoft.com/en-gb/help/2770432/how-to-revert-to-an-earlier-version-of-office-2013-or-office-2016-clic

We and our clients have struggled with this the last two days and finally wrote a paper to discuss the issue in detail along with some solutions: http://fmsinc.com/MicrosoftAccess/Errors/query_is_corrupt/
It includes our findings that it impacts Access solutions when running update queries on local tables, linked Access tables, and even linked SQL Server tables.
It also impacts non-Microsoft Access solutions using the Access Database Engine (ACE) to connect to Access databases using ADO. That includes Visual Studio (WinForm) apps, VB6 apps, and even web sites that update Access databases on machines that never had Access or Office installed on them.
This crash can even impact Microsoft apps that use ACE such as PowerBI, Power Query, SSMA, etc. (not confirmed), and of course, other programs such as Excel, PowerPoint or Word using VBA to modify Access databases.
In addition to the obvious uninstallation of the offending Security Updates, we also include some options when it's not possible to uninstall due to permissions or distribution of Access applications to external customers whose PCs are beyond your control. That includes changing all the Update queries and distributing the Access applications using Access 2007 (retail or runtime) since that version isn't impacted by the security updates.

Use the following module to automatically implement Microsofts suggested workaround (using a query instead of a table). As a precaution, backup your database first.
Use AddWorkaroundForCorruptedQueryIssue() to add the workaround and RemoveWorkaroundForCorruptedQueryIssue() to remove it at any time.
Option Compare Database
Option Explicit
Private Const WorkaroundTableSuffix As String = "_Table"
Public Sub AddWorkaroundForCorruptedQueryIssue()
On Error Resume Next
With CurrentDb
Dim tableDef As tableDef
For Each tableDef In .tableDefs
Dim isSystemTable As Boolean
isSystemTable = tableDef.Attributes And dbSystemObject
If Not EndsWith(tableDef.Name, WorkaroundTableSuffix) And Not isSystemTable Then
Dim originalTableName As String
originalTableName = tableDef.Name
tableDef.Name = tableDef.Name & WorkaroundTableSuffix
Call .CreateQueryDef(originalTableName, "select * from [" & tableDef.Name & "]")
Debug.Print "OldTableName/NewQueryName" & vbTab & "[" & originalTableName & "]" & vbTab & _
"NewTableName" & vbTab & "[" & tableDef.Name & "]"
End If
Next
End With
End Sub
Public Sub RemoveWorkaroundForCorruptedQueryIssue()
On Error Resume Next
With CurrentDb
Dim tableDef As tableDef
For Each tableDef In .tableDefs
Dim isSystemTable As Boolean
isSystemTable = tableDef.Attributes And dbSystemObject
If EndsWith(tableDef.Name, WorkaroundTableSuffix) And Not isSystemTable Then
Dim originalTableName As String
originalTableName = Left(tableDef.Name, Len(tableDef.Name) - Len(WorkaroundTableSuffix))
Dim workaroundTableName As String
workaroundTableName = tableDef.Name
Call .QueryDefs.Delete(originalTableName)
tableDef.Name = originalTableName
Debug.Print "OldTableName" & vbTab & "[" & workaroundTableName & "]" & vbTab & _
"NewTableName" & vbTab & "[" & tableDef.Name & "]" & vbTab & "(Query deleted)"
End If
Next
End With
End Sub
'From https://excelrevisited.blogspot.com/2012/06/endswith.html
Private Function EndsWith(str As String, ending As String) As Boolean
Dim endingLen As Integer
endingLen = Len(ending)
EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
End Function
You can find the latest code on my GitHub repository.
AddWorkaroundForCorruptedQueryIssue() will add the suffix _Table to all non-system tables, e.g. the table IceCreams would be renamed to IceCreams_Table.
It will also create a new query using the original table name, that will select all columns of the renamed table. In our example, the query would be named IceCreams and would execute the SQL select * from [IceCreams_Table].
RemoveWorkaroundForCorruptedQueryIssue() does the reverse actions.
I tested this with all kinds of tables, including external non-MDB tables (like SQL Server). But be aware, that using a query instead of a table can lead to non-optimized queries being executed against a backend database in specific cases, especially if your original queries that used the tables are either of poor quality or very complex.
(And of course, depending on your coding style, it is also possible to break things in your application. So after verifying that the fix generally works for you, it's never a bad idea to export all your objects as text and use some find replace magic to ensure that any occurrences of table names use will be run against the queries and not the tables.)
In my case, this fix works largely without any side effects, I just needed to manually rename USysRibbons_Table back to USysRibbons, as I hadn't marked it as a system table when I created it in the past.

For those looking to automate this process via PowerShell, here are a few links I found that may be helpful:
Detect and Remove the Offending Updates
There is a PowerShell script available here https://www.arcath.net/2017/09/office-update-remover that searches the registry for a specific Office update (passed in as a kb number) and removes it using a call to msiexec.exe. This script parses out both GUIDs from the registry keys to build the command to remove the appropriate update.
One change that I would suggest would be using the /REBOOT=REALLYSUPPRESS as described in How to uninstall KB4011626 and other Office updates (Additional reference: https://learn.microsoft.com/en-us/windows/win32/msi/uninstalling-patches). The command line you are building looks like this:
msiexec /i {90160000-0011-0000-0000-0000000FF1CE} MSIPATCHREMOVE={9894BF35-19C1-4C89-A683-D40E94D08C77} /qn REBOOT=REALLYSUPPRESS
The command to run the script would look something like this:
OfficeUpdateRemover.ps1 -kb 4484127
Prevent the Updates from Installing
The recommended approach here seems to be hiding the update. Obviously this can be done manually, but there are some PowerShell scripts that can help with automation.
This link: https://www.maketecheasier.com/hide-updates-in-windows-10/ describes the process in detail, but I will summarize it here.
Install the Windows Update PowerShell Module.
Use the following command to hide an update by KB number:
Hide-WUUpdate -KBArticleID KB4484127
Hopefully this will be a help to someone else out there.

VBA-Script for MS-Workaround:
It is recommended to remove the buggy update, if possible (if not try my code), at least for the MSI Versions. See answer https://stackoverflow.com/a/58833831/9439330 .
For CTR(Click-To-Run) Versions, you have to remove all Office November-Updates, what may cause serious security issues (not sure if any critical fixes would be removed).
From #Eric's comments:
If you useTable.Tablenameto bind forms, they get unbound as the former table-name is now a query-name!.
OpenRecordSet(FormerTableNowAQuery, dbOpenTable) will fail ( as its a query now, not a table anymore)
Caution! Just quick tested against Northwind.accdb on Office 2013 x86 CTR No Warranty!
Private Sub RenameTablesAndCreateQueryDefs()
With CurrentDb
Dim tdf As DAO.TableDef
For Each tdf In .TableDefs
Dim oldName As String
oldName = tdf.Name
If Not (tdf.Attributes And dbSystemObject) Then 'credit to #lauxjpn for better check for system-tables
Dim AllFields As String
AllFields = vbNullString
Dim fld As DAO.Field
For Each fld In tdf.Fields
AllFields = AllFields & "[" & fld.Name & "], "
Next fld
AllFields = Left(AllFields, Len(AllFields) - 2)
Dim newName As String
newName = oldName
On Error Resume Next
Do
Err.Clear
newName = newName & "_"
tdf.Name = newName
Loop While Err.Number = 3012
On Error GoTo 0
Dim qdf As DAO.QueryDef
Set qdf = .CreateQueryDef(oldName)
qdf.SQL = "SELECT " & AllFields & " FROM [" & newName & "]"
End If
Next
.TableDefs.Refresh
End With
End Sub
For testing:
Private Sub TestError()
With CurrentDb
.Execute "Update customers Set City = 'a' Where 1=1", dbFailOnError 'works
.Execute "Update customers_ Set City = 'b' Where 1=1", dbFailOnError 'fails
End With
End Sub

I replaced the currentDb.Execute and Docmd.RunSQL with a helper function. That can pre-process and change the SQL Statement if any update statement contains only one table. I already have a dual(single row, single column) table so i went with a fakeTable option.
Note: This won't change your query objects. It will only help SQL executions via VBA. If you would like to change your query objects, use FnQueryReplaceSingleTableUpdateStatements and update your sql in each of your querydefs. Shouldn't be a problem either.
This is just a concept (If it's a single table update modify the sql before execution). Adapt it as per your needs. This method does not create replacement queries for each table (which may be the easiest way but has it's own drawbacks. i.e performance issues)
+Points:
You can continue to use this helper even after MS fixing the bug it won't change anything. In case, future brings another problem, you are ready to pre-process your SQL in one place. I didn't go for uninstalling updates method because that requires Admin access + gonna take too long to get everyone on the correct version + even if you uninstall, some end users's group policy installs the latest update again. You are back to the same problem.
If you have access to the source-code, use this method and you are 100% sure that no enduser is having the issue.
Public Function Execute(Query As String, Optional Options As Variant)
'Direct replacement for currentDb.Execute
If IsBlank(Query) Then Exit Function
'invalid db options remove
If Not IsMissing(Options) Then
If (Options = True) Then
'DoCmd RunSql query,True ' True should fail so transactions can be reverted
'We are only doing this so DoCmd.RunSQL query, true can be directly replaced by helper.Execute query, true.
Options = dbFailOnError
End If
End If
'Preprocessing the sql command to remove single table updates
Query = FnQueryReplaceSingleTableUpdateStatements(Query)
'Execute the command
If ((Not IsMissing(Options)) And (CLng(Options) > 0)) Then
currentDb.Execute Query, Options
Else
currentDb.Execute Query
End If
End Function
Public Function FnQueryReplaceSingleTableUpdateStatements(Query As String) As String
' ON November 2019 Microsoft released a buggy security update that affected single table updates.
'https://stackoverflow.com/questions/58832269/getting-error-3340-query-is-corrupt-while-executing-queries-docmd-runsql
Dim singleTableUpdate As String
Dim tableName As String
Const updateWord As String = "update"
Const setWord As String = "set"
If IsBlank(Query) Then Exit Function
'Find the update statement between UPDATE ... SET
singleTableUpdate = FnQueryContainsSingleTableUpdate(Query)
'do we have any match? if any match found, that needs to be preprocessed
If Not (IsBlank(singleTableUpdate)) Then
'Remove UPDATe keyword
If (VBA.Left(singleTableUpdate, Len(updateWord)) = updateWord) Then
tableName = VBA.Right(singleTableUpdate, Len(singleTableUpdate) - Len(updateWord))
End If
'Remove SET keyword
If (VBA.Right(tableName, Len(setWord)) = setWord) Then
tableName = VBA.Left(tableName, Len(tableName) - Len(setWord))
End If
'Decide which method you want to go for. SingleRow table or Select?
'I'm going with a fake/dual table.
'If you are going with update (select * from T) as T, make sure table aliases are correctly assigned.
tableName = gDll.sFormat("UPDATE {0},{1} SET ", tableName, ModTableNames.FakeTableName)
'replace the query with the new statement
Query = vba.Replace(Query, singleTableUpdate, tableName, compare:=vbDatabaseCompare, Count:=1)
End If
FnQueryReplaceSingleTableUpdateStatements = Query
End Function
Public Function FnQueryContainsSingleTableUpdate(Query As String) As String
'Returns the update ... SET statment if it contains only one table.
FnQueryContainsSingleTableUpdate = ""
If IsBlank(Query) Then Exit Function
Dim pattern As String
Dim firstMatch As String
'Get the pattern from your settings repository or hardcode it.
pattern = "(update)+(\w|\s(?!join))*set"
FnQueryContainsSingleTableUpdate = FN_REGEX_GET_FIRST_MATCH(Query, pattern, isGlobal:=True, isMultiline:=True, doIgnoreCase:=True)
End Function
Public Function FN_REGEX_GET_FIRST_MATCH(iText As String, iPattern As String, Optional isGlobal As Boolean = True, Optional isMultiline As Boolean = True, Optional doIgnoreCase As Boolean = True) As String
'Returns first match or ""
If IsBlank(iText) Then Exit Function
If IsBlank(iPattern) Then Exit Function
Dim objRegex As Object
Dim allMatches As Variant
Dim I As Long
FN_REGEX_GET_FIRST_MATCH = ""
On Error GoTo FN_REGEX_GET_FIRST_MATCH_Error
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Multiline = isMultiline
.Global = isGlobal
.IgnoreCase = doIgnoreCase
.pattern = iPattern
If .test(iText) Then
Set allMatches = .Execute(iText)
If allMatches.Count > 0 Then
FN_REGEX_GET_FIRST_MATCH = allMatches.item(0)
End If
End If
End With
Set objRegex = Nothing
On Error GoTo 0
Exit Function
FN_REGEX_GET_FIRST_MATCH_Error:
FN_REGEX_GET_FIRST_MATCH = ""
End Function
Now just CTRL+F
Search and replace docmd.RunSQL with helper.Execute
Search and replace [currentdb|dbengine|or your dbobject].execute with helper.execute
have fun!

Ok I'll chime in here as well, because even though this bug has been fixed, that fix has yet to populate fully through various enterprises where the end users may not be able to update (like my employer...)
Here's my workaround for DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1". Just comment out the offending query and drop in the code below.
'DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1"
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("users")
rst.MoveLast
rst.MoveFirst
rst.FindFirst "[usercode] = 1" 'note: if field is text, use "[usercode] = '1'"
rst.Edit
rst![uname] = "bob"
rst.Update
rst.Close
Set rst = Nothing
I can't say it's pretty, but it gets the job done.

Related

What is the solution to "Query " is corrupt" error after latest windows security update [duplicate]

Since installing the windows update for Office 2010 resolving KB 4484127 I get an error while executing queries which contain a WHERE clause.
For example executing this query:
DoCmd.RunSQL "update users set uname= 'bob' where usercode=1"
Results in this error:
Error number = 3340 Query ' ' is corrupt
The update in question is currently still installed:
How can I successfully run my queries? Should I just uninstall this update?
Summary
This is a known bug caused by the Office updates released on November 12, 2019. The bug affects all versions of Access currently supported by Microsoft (from Access 2010 to 365).
This bug has been fixed.
If you use a C2R (Click-to-Run) version of Office, use "Update now":
Access 2010 C2R: Fixed in Build 7243.5000
Access 2013 C2R: Fixed in Build 5197.1000
Access 2016 C2R: Fixed in Build 12130.20390
Access 2019 (v1910): Fixed in Build 12130.20390
Access 2019 (Volume License): Fixed in Build 10353.20037
Office 365 Monthly Channel: Fixed in Build 12130.20390
Office 365 Semi-Annual: Fixed in Build 11328.20480
Office 365 Semi-Annual Extended: Fixed in Build 10730.20422
Office 365 Semi-Annual Targeted: Fixed in Build 11929.20494
If you use an MSI version of Office, install the update matching your Office version. All of these patches have been released on Microsoft Update, so installing all pending Windows Updates should suffice:
Access 2010 MSI: Fixed in KB4484193
Access 2013 MSI: Fixed in KB4484186
Access 2016 MSI: Fixed in KB4484180
Example
Here is a minimal repro example:
Create a new Access database.
Create a new, empty table "Table1" with the default ID field and a Long Integer field "myint".
Execute the following code in the VBA editor's Immediate Window:
CurrentDb.Execute "UPDATE Table1 SET myint = 1 WHERE myint = 1"
Expected result: The statement successfully finishes.
Actual result with one of the buggy updates installed: Run-time error 3340 occurs ("Query '' is corrupt").
Related links:
MSDN forum thread
Official Microsoft page for this bug
Simplest Solution
For my users, waiting nearly a month till December 10 for a fix release from Microsoft is not an option. Nor is uninstalling the offending Microsoft update across several government locked down workstations.
I need to apply a workaround, but am not exactly thrilled with what Microsoft suggested - creating and substituting a query for each table.
The solution is to replace the Table name with a simple (SELECT * FROM Table) query directly in the UPDATE command. This does not require creating and saving a ton of additional queries, tables, or functions.
EXAMPLE:
Before:
UPDATE Table1 SET Field1 = "x" WHERE (Field2=1);
After:
UPDATE (SELECT * FROM Table1) SET Field1 = "x" WHERE (Field2=1);
That should be much easier to implement across several databases and applications (and later rollback).
This is not a Windows update problem, but a problem that was introduced with the November Patch Tuesday Office release. A change to fix a security vulnerability causes some legitimate queries to be reported as corrupt.
Because the change was a security fix, it impacts ALL builds of Office, including 2010, 2013, 2016, 2019, and O365.
The bug has been fixed in all channels, but the timing of delivery will depend on what channel you are on.
For 2010, 2013, and 2016 MSI, and 2019 Volume License builds, and the O365 Semi-annual channel, the fix will be in the December Patch Tuesday build, Dec 10.
For O365, Monthly Channel, and Insiders, this will be fixed when the October fork is released, currently planned for Nov 24.
For the Semi-Annual channel, the bug was introduced in 11328.20468, which was released Nov 12, but doesn’t roll out to everyone all at once.
If you can, you might want to hold off on updating until Dec 10.
The issue occurs for update queries against a single table with a criteria specified (so other types of queries shouldn’t be impacted, nor any query that updates all rows of a table, nor a query that updates the result set of another query).
Given that, the simplest workaround in most cases is to change the update query to update another query that selects everything from the table, rather than updating the query directly.
I.e., if you have a query like:
UPDATE Table1 SET Table1.Field1 = "x" WHERE ([Table1].[Field2]=1);
Then, create a new query (Query1) defined as:
Select * from Table1;
and update your original query to:
UPDATE Query1 SET Query1.Field1 = "x" WHERE ([Query1].[Field2]=1);
Official page: Access error: "Query is corrupt"
To temporarily resolve this issue depends on the Access version in use:
Access 2010 Uninstall update KB4484127
Access 2013 Uninstall update KB4484119
Access 2016 Uninstall update KB4484113
Access 2019 IF REQUIRED (tbc). Downgrade from Version 1808 (Build 10352.20042) to Version 1808 (Build 10351.20054)
Office 365 ProPlus Downgrade from Version 1910 (Build 12130.20344) to a previous build, see https://support.microsoft.com/en-gb/help/2770432/how-to-revert-to-an-earlier-version-of-office-2013-or-office-2016-clic
We and our clients have struggled with this the last two days and finally wrote a paper to discuss the issue in detail along with some solutions: http://fmsinc.com/MicrosoftAccess/Errors/query_is_corrupt/
It includes our findings that it impacts Access solutions when running update queries on local tables, linked Access tables, and even linked SQL Server tables.
It also impacts non-Microsoft Access solutions using the Access Database Engine (ACE) to connect to Access databases using ADO. That includes Visual Studio (WinForm) apps, VB6 apps, and even web sites that update Access databases on machines that never had Access or Office installed on them.
This crash can even impact Microsoft apps that use ACE such as PowerBI, Power Query, SSMA, etc. (not confirmed), and of course, other programs such as Excel, PowerPoint or Word using VBA to modify Access databases.
In addition to the obvious uninstallation of the offending Security Updates, we also include some options when it's not possible to uninstall due to permissions or distribution of Access applications to external customers whose PCs are beyond your control. That includes changing all the Update queries and distributing the Access applications using Access 2007 (retail or runtime) since that version isn't impacted by the security updates.
Use the following module to automatically implement Microsofts suggested workaround (using a query instead of a table). As a precaution, backup your database first.
Use AddWorkaroundForCorruptedQueryIssue() to add the workaround and RemoveWorkaroundForCorruptedQueryIssue() to remove it at any time.
Option Compare Database
Option Explicit
Private Const WorkaroundTableSuffix As String = "_Table"
Public Sub AddWorkaroundForCorruptedQueryIssue()
On Error Resume Next
With CurrentDb
Dim tableDef As tableDef
For Each tableDef In .tableDefs
Dim isSystemTable As Boolean
isSystemTable = tableDef.Attributes And dbSystemObject
If Not EndsWith(tableDef.Name, WorkaroundTableSuffix) And Not isSystemTable Then
Dim originalTableName As String
originalTableName = tableDef.Name
tableDef.Name = tableDef.Name & WorkaroundTableSuffix
Call .CreateQueryDef(originalTableName, "select * from [" & tableDef.Name & "]")
Debug.Print "OldTableName/NewQueryName" & vbTab & "[" & originalTableName & "]" & vbTab & _
"NewTableName" & vbTab & "[" & tableDef.Name & "]"
End If
Next
End With
End Sub
Public Sub RemoveWorkaroundForCorruptedQueryIssue()
On Error Resume Next
With CurrentDb
Dim tableDef As tableDef
For Each tableDef In .tableDefs
Dim isSystemTable As Boolean
isSystemTable = tableDef.Attributes And dbSystemObject
If EndsWith(tableDef.Name, WorkaroundTableSuffix) And Not isSystemTable Then
Dim originalTableName As String
originalTableName = Left(tableDef.Name, Len(tableDef.Name) - Len(WorkaroundTableSuffix))
Dim workaroundTableName As String
workaroundTableName = tableDef.Name
Call .QueryDefs.Delete(originalTableName)
tableDef.Name = originalTableName
Debug.Print "OldTableName" & vbTab & "[" & workaroundTableName & "]" & vbTab & _
"NewTableName" & vbTab & "[" & tableDef.Name & "]" & vbTab & "(Query deleted)"
End If
Next
End With
End Sub
'From https://excelrevisited.blogspot.com/2012/06/endswith.html
Private Function EndsWith(str As String, ending As String) As Boolean
Dim endingLen As Integer
endingLen = Len(ending)
EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
End Function
You can find the latest code on my GitHub repository.
AddWorkaroundForCorruptedQueryIssue() will add the suffix _Table to all non-system tables, e.g. the table IceCreams would be renamed to IceCreams_Table.
It will also create a new query using the original table name, that will select all columns of the renamed table. In our example, the query would be named IceCreams and would execute the SQL select * from [IceCreams_Table].
RemoveWorkaroundForCorruptedQueryIssue() does the reverse actions.
I tested this with all kinds of tables, including external non-MDB tables (like SQL Server). But be aware, that using a query instead of a table can lead to non-optimized queries being executed against a backend database in specific cases, especially if your original queries that used the tables are either of poor quality or very complex.
(And of course, depending on your coding style, it is also possible to break things in your application. So after verifying that the fix generally works for you, it's never a bad idea to export all your objects as text and use some find replace magic to ensure that any occurrences of table names use will be run against the queries and not the tables.)
In my case, this fix works largely without any side effects, I just needed to manually rename USysRibbons_Table back to USysRibbons, as I hadn't marked it as a system table when I created it in the past.
For those looking to automate this process via PowerShell, here are a few links I found that may be helpful:
Detect and Remove the Offending Updates
There is a PowerShell script available here https://www.arcath.net/2017/09/office-update-remover that searches the registry for a specific Office update (passed in as a kb number) and removes it using a call to msiexec.exe. This script parses out both GUIDs from the registry keys to build the command to remove the appropriate update.
One change that I would suggest would be using the /REBOOT=REALLYSUPPRESS as described in How to uninstall KB4011626 and other Office updates (Additional reference: https://learn.microsoft.com/en-us/windows/win32/msi/uninstalling-patches). The command line you are building looks like this:
msiexec /i {90160000-0011-0000-0000-0000000FF1CE} MSIPATCHREMOVE={9894BF35-19C1-4C89-A683-D40E94D08C77} /qn REBOOT=REALLYSUPPRESS
The command to run the script would look something like this:
OfficeUpdateRemover.ps1 -kb 4484127
Prevent the Updates from Installing
The recommended approach here seems to be hiding the update. Obviously this can be done manually, but there are some PowerShell scripts that can help with automation.
This link: https://www.maketecheasier.com/hide-updates-in-windows-10/ describes the process in detail, but I will summarize it here.
Install the Windows Update PowerShell Module.
Use the following command to hide an update by KB number:
Hide-WUUpdate -KBArticleID KB4484127
Hopefully this will be a help to someone else out there.
VBA-Script for MS-Workaround:
It is recommended to remove the buggy update, if possible (if not try my code), at least for the MSI Versions. See answer https://stackoverflow.com/a/58833831/9439330 .
For CTR(Click-To-Run) Versions, you have to remove all Office November-Updates, what may cause serious security issues (not sure if any critical fixes would be removed).
From #Eric's comments:
If you useTable.Tablenameto bind forms, they get unbound as the former table-name is now a query-name!.
OpenRecordSet(FormerTableNowAQuery, dbOpenTable) will fail ( as its a query now, not a table anymore)
Caution! Just quick tested against Northwind.accdb on Office 2013 x86 CTR No Warranty!
Private Sub RenameTablesAndCreateQueryDefs()
With CurrentDb
Dim tdf As DAO.TableDef
For Each tdf In .TableDefs
Dim oldName As String
oldName = tdf.Name
If Not (tdf.Attributes And dbSystemObject) Then 'credit to #lauxjpn for better check for system-tables
Dim AllFields As String
AllFields = vbNullString
Dim fld As DAO.Field
For Each fld In tdf.Fields
AllFields = AllFields & "[" & fld.Name & "], "
Next fld
AllFields = Left(AllFields, Len(AllFields) - 2)
Dim newName As String
newName = oldName
On Error Resume Next
Do
Err.Clear
newName = newName & "_"
tdf.Name = newName
Loop While Err.Number = 3012
On Error GoTo 0
Dim qdf As DAO.QueryDef
Set qdf = .CreateQueryDef(oldName)
qdf.SQL = "SELECT " & AllFields & " FROM [" & newName & "]"
End If
Next
.TableDefs.Refresh
End With
End Sub
For testing:
Private Sub TestError()
With CurrentDb
.Execute "Update customers Set City = 'a' Where 1=1", dbFailOnError 'works
.Execute "Update customers_ Set City = 'b' Where 1=1", dbFailOnError 'fails
End With
End Sub
I replaced the currentDb.Execute and Docmd.RunSQL with a helper function. That can pre-process and change the SQL Statement if any update statement contains only one table. I already have a dual(single row, single column) table so i went with a fakeTable option.
Note: This won't change your query objects. It will only help SQL executions via VBA. If you would like to change your query objects, use FnQueryReplaceSingleTableUpdateStatements and update your sql in each of your querydefs. Shouldn't be a problem either.
This is just a concept (If it's a single table update modify the sql before execution). Adapt it as per your needs. This method does not create replacement queries for each table (which may be the easiest way but has it's own drawbacks. i.e performance issues)
+Points:
You can continue to use this helper even after MS fixing the bug it won't change anything. In case, future brings another problem, you are ready to pre-process your SQL in one place. I didn't go for uninstalling updates method because that requires Admin access + gonna take too long to get everyone on the correct version + even if you uninstall, some end users's group policy installs the latest update again. You are back to the same problem.
If you have access to the source-code, use this method and you are 100% sure that no enduser is having the issue.
Public Function Execute(Query As String, Optional Options As Variant)
'Direct replacement for currentDb.Execute
If IsBlank(Query) Then Exit Function
'invalid db options remove
If Not IsMissing(Options) Then
If (Options = True) Then
'DoCmd RunSql query,True ' True should fail so transactions can be reverted
'We are only doing this so DoCmd.RunSQL query, true can be directly replaced by helper.Execute query, true.
Options = dbFailOnError
End If
End If
'Preprocessing the sql command to remove single table updates
Query = FnQueryReplaceSingleTableUpdateStatements(Query)
'Execute the command
If ((Not IsMissing(Options)) And (CLng(Options) > 0)) Then
currentDb.Execute Query, Options
Else
currentDb.Execute Query
End If
End Function
Public Function FnQueryReplaceSingleTableUpdateStatements(Query As String) As String
' ON November 2019 Microsoft released a buggy security update that affected single table updates.
'https://stackoverflow.com/questions/58832269/getting-error-3340-query-is-corrupt-while-executing-queries-docmd-runsql
Dim singleTableUpdate As String
Dim tableName As String
Const updateWord As String = "update"
Const setWord As String = "set"
If IsBlank(Query) Then Exit Function
'Find the update statement between UPDATE ... SET
singleTableUpdate = FnQueryContainsSingleTableUpdate(Query)
'do we have any match? if any match found, that needs to be preprocessed
If Not (IsBlank(singleTableUpdate)) Then
'Remove UPDATe keyword
If (VBA.Left(singleTableUpdate, Len(updateWord)) = updateWord) Then
tableName = VBA.Right(singleTableUpdate, Len(singleTableUpdate) - Len(updateWord))
End If
'Remove SET keyword
If (VBA.Right(tableName, Len(setWord)) = setWord) Then
tableName = VBA.Left(tableName, Len(tableName) - Len(setWord))
End If
'Decide which method you want to go for. SingleRow table or Select?
'I'm going with a fake/dual table.
'If you are going with update (select * from T) as T, make sure table aliases are correctly assigned.
tableName = gDll.sFormat("UPDATE {0},{1} SET ", tableName, ModTableNames.FakeTableName)
'replace the query with the new statement
Query = vba.Replace(Query, singleTableUpdate, tableName, compare:=vbDatabaseCompare, Count:=1)
End If
FnQueryReplaceSingleTableUpdateStatements = Query
End Function
Public Function FnQueryContainsSingleTableUpdate(Query As String) As String
'Returns the update ... SET statment if it contains only one table.
FnQueryContainsSingleTableUpdate = ""
If IsBlank(Query) Then Exit Function
Dim pattern As String
Dim firstMatch As String
'Get the pattern from your settings repository or hardcode it.
pattern = "(update)+(\w|\s(?!join))*set"
FnQueryContainsSingleTableUpdate = FN_REGEX_GET_FIRST_MATCH(Query, pattern, isGlobal:=True, isMultiline:=True, doIgnoreCase:=True)
End Function
Public Function FN_REGEX_GET_FIRST_MATCH(iText As String, iPattern As String, Optional isGlobal As Boolean = True, Optional isMultiline As Boolean = True, Optional doIgnoreCase As Boolean = True) As String
'Returns first match or ""
If IsBlank(iText) Then Exit Function
If IsBlank(iPattern) Then Exit Function
Dim objRegex As Object
Dim allMatches As Variant
Dim I As Long
FN_REGEX_GET_FIRST_MATCH = ""
On Error GoTo FN_REGEX_GET_FIRST_MATCH_Error
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Multiline = isMultiline
.Global = isGlobal
.IgnoreCase = doIgnoreCase
.pattern = iPattern
If .test(iText) Then
Set allMatches = .Execute(iText)
If allMatches.Count > 0 Then
FN_REGEX_GET_FIRST_MATCH = allMatches.item(0)
End If
End If
End With
Set objRegex = Nothing
On Error GoTo 0
Exit Function
FN_REGEX_GET_FIRST_MATCH_Error:
FN_REGEX_GET_FIRST_MATCH = ""
End Function
Now just CTRL+F
Search and replace docmd.RunSQL with helper.Execute
Search and replace [currentdb|dbengine|or your dbobject].execute with helper.execute
have fun!
Ok I'll chime in here as well, because even though this bug has been fixed, that fix has yet to populate fully through various enterprises where the end users may not be able to update (like my employer...)
Here's my workaround for DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1". Just comment out the offending query and drop in the code below.
'DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1"
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("users")
rst.MoveLast
rst.MoveFirst
rst.FindFirst "[usercode] = 1" 'note: if field is text, use "[usercode] = '1'"
rst.Edit
rst![uname] = "bob"
rst.Update
rst.Close
Set rst = Nothing
I can't say it's pretty, but it gets the job done.

Getting Error 3340 Query ' ' is corrupt while executing queries DoCmd.RunSQL

Since installing the windows update for Office 2010 resolving KB 4484127 I get an error while executing queries which contain a WHERE clause.
For example executing this query:
DoCmd.RunSQL "update users set uname= 'bob' where usercode=1"
Results in this error:
Error number = 3340 Query ' ' is corrupt
The update in question is currently still installed:
How can I successfully run my queries? Should I just uninstall this update?
Summary
This is a known bug caused by the Office updates released on November 12, 2019. The bug affects all versions of Access currently supported by Microsoft (from Access 2010 to 365).
This bug has been fixed.
If you use a C2R (Click-to-Run) version of Office, use "Update now":
Access 2010 C2R: Fixed in Build 7243.5000
Access 2013 C2R: Fixed in Build 5197.1000
Access 2016 C2R: Fixed in Build 12130.20390
Access 2019 (v1910): Fixed in Build 12130.20390
Access 2019 (Volume License): Fixed in Build 10353.20037
Office 365 Monthly Channel: Fixed in Build 12130.20390
Office 365 Semi-Annual: Fixed in Build 11328.20480
Office 365 Semi-Annual Extended: Fixed in Build 10730.20422
Office 365 Semi-Annual Targeted: Fixed in Build 11929.20494
If you use an MSI version of Office, install the update matching your Office version. All of these patches have been released on Microsoft Update, so installing all pending Windows Updates should suffice:
Access 2010 MSI: Fixed in KB4484193
Access 2013 MSI: Fixed in KB4484186
Access 2016 MSI: Fixed in KB4484180
Example
Here is a minimal repro example:
Create a new Access database.
Create a new, empty table "Table1" with the default ID field and a Long Integer field "myint".
Execute the following code in the VBA editor's Immediate Window:
CurrentDb.Execute "UPDATE Table1 SET myint = 1 WHERE myint = 1"
Expected result: The statement successfully finishes.
Actual result with one of the buggy updates installed: Run-time error 3340 occurs ("Query '' is corrupt").
Related links:
MSDN forum thread
Official Microsoft page for this bug
Simplest Solution
For my users, waiting nearly a month till December 10 for a fix release from Microsoft is not an option. Nor is uninstalling the offending Microsoft update across several government locked down workstations.
I need to apply a workaround, but am not exactly thrilled with what Microsoft suggested - creating and substituting a query for each table.
The solution is to replace the Table name with a simple (SELECT * FROM Table) query directly in the UPDATE command. This does not require creating and saving a ton of additional queries, tables, or functions.
EXAMPLE:
Before:
UPDATE Table1 SET Field1 = "x" WHERE (Field2=1);
After:
UPDATE (SELECT * FROM Table1) SET Field1 = "x" WHERE (Field2=1);
That should be much easier to implement across several databases and applications (and later rollback).
This is not a Windows update problem, but a problem that was introduced with the November Patch Tuesday Office release. A change to fix a security vulnerability causes some legitimate queries to be reported as corrupt.
Because the change was a security fix, it impacts ALL builds of Office, including 2010, 2013, 2016, 2019, and O365.
The bug has been fixed in all channels, but the timing of delivery will depend on what channel you are on.
For 2010, 2013, and 2016 MSI, and 2019 Volume License builds, and the O365 Semi-annual channel, the fix will be in the December Patch Tuesday build, Dec 10.
For O365, Monthly Channel, and Insiders, this will be fixed when the October fork is released, currently planned for Nov 24.
For the Semi-Annual channel, the bug was introduced in 11328.20468, which was released Nov 12, but doesn’t roll out to everyone all at once.
If you can, you might want to hold off on updating until Dec 10.
The issue occurs for update queries against a single table with a criteria specified (so other types of queries shouldn’t be impacted, nor any query that updates all rows of a table, nor a query that updates the result set of another query).
Given that, the simplest workaround in most cases is to change the update query to update another query that selects everything from the table, rather than updating the query directly.
I.e., if you have a query like:
UPDATE Table1 SET Table1.Field1 = "x" WHERE ([Table1].[Field2]=1);
Then, create a new query (Query1) defined as:
Select * from Table1;
and update your original query to:
UPDATE Query1 SET Query1.Field1 = "x" WHERE ([Query1].[Field2]=1);
Official page: Access error: "Query is corrupt"
To temporarily resolve this issue depends on the Access version in use:
Access 2010 Uninstall update KB4484127
Access 2013 Uninstall update KB4484119
Access 2016 Uninstall update KB4484113
Access 2019 IF REQUIRED (tbc). Downgrade from Version 1808 (Build 10352.20042) to Version 1808 (Build 10351.20054)
Office 365 ProPlus Downgrade from Version 1910 (Build 12130.20344) to a previous build, see https://support.microsoft.com/en-gb/help/2770432/how-to-revert-to-an-earlier-version-of-office-2013-or-office-2016-clic
We and our clients have struggled with this the last two days and finally wrote a paper to discuss the issue in detail along with some solutions: http://fmsinc.com/MicrosoftAccess/Errors/query_is_corrupt/
It includes our findings that it impacts Access solutions when running update queries on local tables, linked Access tables, and even linked SQL Server tables.
It also impacts non-Microsoft Access solutions using the Access Database Engine (ACE) to connect to Access databases using ADO. That includes Visual Studio (WinForm) apps, VB6 apps, and even web sites that update Access databases on machines that never had Access or Office installed on them.
This crash can even impact Microsoft apps that use ACE such as PowerBI, Power Query, SSMA, etc. (not confirmed), and of course, other programs such as Excel, PowerPoint or Word using VBA to modify Access databases.
In addition to the obvious uninstallation of the offending Security Updates, we also include some options when it's not possible to uninstall due to permissions or distribution of Access applications to external customers whose PCs are beyond your control. That includes changing all the Update queries and distributing the Access applications using Access 2007 (retail or runtime) since that version isn't impacted by the security updates.
Use the following module to automatically implement Microsofts suggested workaround (using a query instead of a table). As a precaution, backup your database first.
Use AddWorkaroundForCorruptedQueryIssue() to add the workaround and RemoveWorkaroundForCorruptedQueryIssue() to remove it at any time.
Option Compare Database
Option Explicit
Private Const WorkaroundTableSuffix As String = "_Table"
Public Sub AddWorkaroundForCorruptedQueryIssue()
On Error Resume Next
With CurrentDb
Dim tableDef As tableDef
For Each tableDef In .tableDefs
Dim isSystemTable As Boolean
isSystemTable = tableDef.Attributes And dbSystemObject
If Not EndsWith(tableDef.Name, WorkaroundTableSuffix) And Not isSystemTable Then
Dim originalTableName As String
originalTableName = tableDef.Name
tableDef.Name = tableDef.Name & WorkaroundTableSuffix
Call .CreateQueryDef(originalTableName, "select * from [" & tableDef.Name & "]")
Debug.Print "OldTableName/NewQueryName" & vbTab & "[" & originalTableName & "]" & vbTab & _
"NewTableName" & vbTab & "[" & tableDef.Name & "]"
End If
Next
End With
End Sub
Public Sub RemoveWorkaroundForCorruptedQueryIssue()
On Error Resume Next
With CurrentDb
Dim tableDef As tableDef
For Each tableDef In .tableDefs
Dim isSystemTable As Boolean
isSystemTable = tableDef.Attributes And dbSystemObject
If EndsWith(tableDef.Name, WorkaroundTableSuffix) And Not isSystemTable Then
Dim originalTableName As String
originalTableName = Left(tableDef.Name, Len(tableDef.Name) - Len(WorkaroundTableSuffix))
Dim workaroundTableName As String
workaroundTableName = tableDef.Name
Call .QueryDefs.Delete(originalTableName)
tableDef.Name = originalTableName
Debug.Print "OldTableName" & vbTab & "[" & workaroundTableName & "]" & vbTab & _
"NewTableName" & vbTab & "[" & tableDef.Name & "]" & vbTab & "(Query deleted)"
End If
Next
End With
End Sub
'From https://excelrevisited.blogspot.com/2012/06/endswith.html
Private Function EndsWith(str As String, ending As String) As Boolean
Dim endingLen As Integer
endingLen = Len(ending)
EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending))
End Function
You can find the latest code on my GitHub repository.
AddWorkaroundForCorruptedQueryIssue() will add the suffix _Table to all non-system tables, e.g. the table IceCreams would be renamed to IceCreams_Table.
It will also create a new query using the original table name, that will select all columns of the renamed table. In our example, the query would be named IceCreams and would execute the SQL select * from [IceCreams_Table].
RemoveWorkaroundForCorruptedQueryIssue() does the reverse actions.
I tested this with all kinds of tables, including external non-MDB tables (like SQL Server). But be aware, that using a query instead of a table can lead to non-optimized queries being executed against a backend database in specific cases, especially if your original queries that used the tables are either of poor quality or very complex.
(And of course, depending on your coding style, it is also possible to break things in your application. So after verifying that the fix generally works for you, it's never a bad idea to export all your objects as text and use some find replace magic to ensure that any occurrences of table names use will be run against the queries and not the tables.)
In my case, this fix works largely without any side effects, I just needed to manually rename USysRibbons_Table back to USysRibbons, as I hadn't marked it as a system table when I created it in the past.
For those looking to automate this process via PowerShell, here are a few links I found that may be helpful:
Detect and Remove the Offending Updates
There is a PowerShell script available here https://www.arcath.net/2017/09/office-update-remover that searches the registry for a specific Office update (passed in as a kb number) and removes it using a call to msiexec.exe. This script parses out both GUIDs from the registry keys to build the command to remove the appropriate update.
One change that I would suggest would be using the /REBOOT=REALLYSUPPRESS as described in How to uninstall KB4011626 and other Office updates (Additional reference: https://learn.microsoft.com/en-us/windows/win32/msi/uninstalling-patches). The command line you are building looks like this:
msiexec /i {90160000-0011-0000-0000-0000000FF1CE} MSIPATCHREMOVE={9894BF35-19C1-4C89-A683-D40E94D08C77} /qn REBOOT=REALLYSUPPRESS
The command to run the script would look something like this:
OfficeUpdateRemover.ps1 -kb 4484127
Prevent the Updates from Installing
The recommended approach here seems to be hiding the update. Obviously this can be done manually, but there are some PowerShell scripts that can help with automation.
This link: https://www.maketecheasier.com/hide-updates-in-windows-10/ describes the process in detail, but I will summarize it here.
Install the Windows Update PowerShell Module.
Use the following command to hide an update by KB number:
Hide-WUUpdate -KBArticleID KB4484127
Hopefully this will be a help to someone else out there.
VBA-Script for MS-Workaround:
It is recommended to remove the buggy update, if possible (if not try my code), at least for the MSI Versions. See answer https://stackoverflow.com/a/58833831/9439330 .
For CTR(Click-To-Run) Versions, you have to remove all Office November-Updates, what may cause serious security issues (not sure if any critical fixes would be removed).
From #Eric's comments:
If you useTable.Tablenameto bind forms, they get unbound as the former table-name is now a query-name!.
OpenRecordSet(FormerTableNowAQuery, dbOpenTable) will fail ( as its a query now, not a table anymore)
Caution! Just quick tested against Northwind.accdb on Office 2013 x86 CTR No Warranty!
Private Sub RenameTablesAndCreateQueryDefs()
With CurrentDb
Dim tdf As DAO.TableDef
For Each tdf In .TableDefs
Dim oldName As String
oldName = tdf.Name
If Not (tdf.Attributes And dbSystemObject) Then 'credit to #lauxjpn for better check for system-tables
Dim AllFields As String
AllFields = vbNullString
Dim fld As DAO.Field
For Each fld In tdf.Fields
AllFields = AllFields & "[" & fld.Name & "], "
Next fld
AllFields = Left(AllFields, Len(AllFields) - 2)
Dim newName As String
newName = oldName
On Error Resume Next
Do
Err.Clear
newName = newName & "_"
tdf.Name = newName
Loop While Err.Number = 3012
On Error GoTo 0
Dim qdf As DAO.QueryDef
Set qdf = .CreateQueryDef(oldName)
qdf.SQL = "SELECT " & AllFields & " FROM [" & newName & "]"
End If
Next
.TableDefs.Refresh
End With
End Sub
For testing:
Private Sub TestError()
With CurrentDb
.Execute "Update customers Set City = 'a' Where 1=1", dbFailOnError 'works
.Execute "Update customers_ Set City = 'b' Where 1=1", dbFailOnError 'fails
End With
End Sub
I replaced the currentDb.Execute and Docmd.RunSQL with a helper function. That can pre-process and change the SQL Statement if any update statement contains only one table. I already have a dual(single row, single column) table so i went with a fakeTable option.
Note: This won't change your query objects. It will only help SQL executions via VBA. If you would like to change your query objects, use FnQueryReplaceSingleTableUpdateStatements and update your sql in each of your querydefs. Shouldn't be a problem either.
This is just a concept (If it's a single table update modify the sql before execution). Adapt it as per your needs. This method does not create replacement queries for each table (which may be the easiest way but has it's own drawbacks. i.e performance issues)
+Points:
You can continue to use this helper even after MS fixing the bug it won't change anything. In case, future brings another problem, you are ready to pre-process your SQL in one place. I didn't go for uninstalling updates method because that requires Admin access + gonna take too long to get everyone on the correct version + even if you uninstall, some end users's group policy installs the latest update again. You are back to the same problem.
If you have access to the source-code, use this method and you are 100% sure that no enduser is having the issue.
Public Function Execute(Query As String, Optional Options As Variant)
'Direct replacement for currentDb.Execute
If IsBlank(Query) Then Exit Function
'invalid db options remove
If Not IsMissing(Options) Then
If (Options = True) Then
'DoCmd RunSql query,True ' True should fail so transactions can be reverted
'We are only doing this so DoCmd.RunSQL query, true can be directly replaced by helper.Execute query, true.
Options = dbFailOnError
End If
End If
'Preprocessing the sql command to remove single table updates
Query = FnQueryReplaceSingleTableUpdateStatements(Query)
'Execute the command
If ((Not IsMissing(Options)) And (CLng(Options) > 0)) Then
currentDb.Execute Query, Options
Else
currentDb.Execute Query
End If
End Function
Public Function FnQueryReplaceSingleTableUpdateStatements(Query As String) As String
' ON November 2019 Microsoft released a buggy security update that affected single table updates.
'https://stackoverflow.com/questions/58832269/getting-error-3340-query-is-corrupt-while-executing-queries-docmd-runsql
Dim singleTableUpdate As String
Dim tableName As String
Const updateWord As String = "update"
Const setWord As String = "set"
If IsBlank(Query) Then Exit Function
'Find the update statement between UPDATE ... SET
singleTableUpdate = FnQueryContainsSingleTableUpdate(Query)
'do we have any match? if any match found, that needs to be preprocessed
If Not (IsBlank(singleTableUpdate)) Then
'Remove UPDATe keyword
If (VBA.Left(singleTableUpdate, Len(updateWord)) = updateWord) Then
tableName = VBA.Right(singleTableUpdate, Len(singleTableUpdate) - Len(updateWord))
End If
'Remove SET keyword
If (VBA.Right(tableName, Len(setWord)) = setWord) Then
tableName = VBA.Left(tableName, Len(tableName) - Len(setWord))
End If
'Decide which method you want to go for. SingleRow table or Select?
'I'm going with a fake/dual table.
'If you are going with update (select * from T) as T, make sure table aliases are correctly assigned.
tableName = gDll.sFormat("UPDATE {0},{1} SET ", tableName, ModTableNames.FakeTableName)
'replace the query with the new statement
Query = vba.Replace(Query, singleTableUpdate, tableName, compare:=vbDatabaseCompare, Count:=1)
End If
FnQueryReplaceSingleTableUpdateStatements = Query
End Function
Public Function FnQueryContainsSingleTableUpdate(Query As String) As String
'Returns the update ... SET statment if it contains only one table.
FnQueryContainsSingleTableUpdate = ""
If IsBlank(Query) Then Exit Function
Dim pattern As String
Dim firstMatch As String
'Get the pattern from your settings repository or hardcode it.
pattern = "(update)+(\w|\s(?!join))*set"
FnQueryContainsSingleTableUpdate = FN_REGEX_GET_FIRST_MATCH(Query, pattern, isGlobal:=True, isMultiline:=True, doIgnoreCase:=True)
End Function
Public Function FN_REGEX_GET_FIRST_MATCH(iText As String, iPattern As String, Optional isGlobal As Boolean = True, Optional isMultiline As Boolean = True, Optional doIgnoreCase As Boolean = True) As String
'Returns first match or ""
If IsBlank(iText) Then Exit Function
If IsBlank(iPattern) Then Exit Function
Dim objRegex As Object
Dim allMatches As Variant
Dim I As Long
FN_REGEX_GET_FIRST_MATCH = ""
On Error GoTo FN_REGEX_GET_FIRST_MATCH_Error
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Multiline = isMultiline
.Global = isGlobal
.IgnoreCase = doIgnoreCase
.pattern = iPattern
If .test(iText) Then
Set allMatches = .Execute(iText)
If allMatches.Count > 0 Then
FN_REGEX_GET_FIRST_MATCH = allMatches.item(0)
End If
End If
End With
Set objRegex = Nothing
On Error GoTo 0
Exit Function
FN_REGEX_GET_FIRST_MATCH_Error:
FN_REGEX_GET_FIRST_MATCH = ""
End Function
Now just CTRL+F
Search and replace docmd.RunSQL with helper.Execute
Search and replace [currentdb|dbengine|or your dbobject].execute with helper.execute
have fun!
Ok I'll chime in here as well, because even though this bug has been fixed, that fix has yet to populate fully through various enterprises where the end users may not be able to update (like my employer...)
Here's my workaround for DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1". Just comment out the offending query and drop in the code below.
'DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1"
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("users")
rst.MoveLast
rst.MoveFirst
rst.FindFirst "[usercode] = 1" 'note: if field is text, use "[usercode] = '1'"
rst.Edit
rst![uname] = "bob"
rst.Update
rst.Close
Set rst = Nothing
I can't say it's pretty, but it gets the job done.

Access VBA Module cannot get data from Form

OK, so my database was originally designed in Access 2003. On one of the machines I am using a Access 2007 Runtime as the machine does not have Office of any flavor. I am trying to find a solution using the latest version of Access in Office 365. I cannot directly access either the live version running on either Access 2003 or Access 2007 Runtime. I cannot change the versions on the other machines as these are located in a prison and have no internet. This works without issue running in 2003, only the 2007 is the issue. As I am not there and only have 365, I need a solution that will work for all versions.
The functions being used are in separate modules and are not on the actual form. The form is set to have module as that is required to access the objects. The function is to add an session for an inmate to attend the library. This must be verified to make sure there is room at the time and day of week selected, as well as individual session limits.
The issue I am dealing with is the 2007 and 365 versions are unable to get the selected data from a list box (time as a string) and option group (DayofWeek as number) to complete a SQL query instead it inserts nothing and the SQL fails claiming there is an extra ) in my code. The SQL is then used to create a DAO recordset. This is part of a verification of data to ensure limits are not reached.
I have triple checked the string sent to CO_GetSessionDetail to ensure I do not have an extra ). It thinks it does as there is nothing on the right side of my = in the string. I checked the reference to the form and the unbound fields and they all match. It compiles no problem.
THERE IS NO ISSUE IN 2003 ...
The code is posted below.
Function CO_NewCallout() As Boolean
...
' Get Session ID --------------------------------- '
With Form_f_COs_IM
iSession = CO_GetSessionDetail( _
"SessionID", _
"(((t_CO_Sess.DayOfWeek) = " & .CO_Add_DayOfWeek & ") AND " & _
"((t_CO_Sess.tSession) = '" & .CO_Add_tSession & "'))" _
)
If iSession = 0 Then
GoTo CO_NewCallout_Exit
End If
End With
...
End Function
Function CO_GetSessionDetail(stfield As String, stwhere As String) As Variant
'On Error Resume Next
' Variable Declerations -------------------------- '
Dim db As Database
Dim rst As DAO.Recordset
Dim stSQL As String
' Set Variables ---------------------------------- '
Set db = CurrentDb
If stwhere <> "" Then
stwhere = "WHERE " & stwhere
End If
stSQL = _
"SELECT * " & _
"FROM t_CO_Sess " & stwhere
Set rst = db.OpenRecordset(stSQL, dbOpenDynaset)
' Get Session ID --------------------------------- '
With rst
If Not .EOF Then
CO_GetSessionDetail = .Fields(stfield)
Else
CO_GetSessionDetail = 0
End If
End With
' Close Recordset t_CO_Sess ---------------------- '
rst.Close
Set rst = Nothing
End Function
Access 2003 - I get the unique ID of the Session
Access 2007 and 365 - cannot complete function
Let me know if more code would help.
An Access application compiled using Office 365 will not be compatible with the Access 2007 runtime or Access 2003. You must compile on a version earlier or equal to the runtime you choose. Unfortunately, it is hard to get the Access 2003 runtime because it is not freely downloadable. The 2007 runtime is freely available (which probably explains why you chose to install the later version).
Your code looks OK, and I assume it compiles and all that. Despite the fact that your 2003 database should work with the Access 2007 runtime, the fact that it doesn't says to me that you have an incompatibility you need to resolve.
Your best bet: upgrade your app to 2007 or later, ensure it works in the new version, and install the matching runtime on your client's machines.
References:
General discussion of Access version compatibility:
Access 2016/2010 Compatibility, Access 2016
Article on getting the Access 2003 Runtime:
MS Access Runtime 2003

Update query in MS Access 2010 exhausts system resources

For reasons beyond my control we are using Access 2010 to update linked SharePoint lists to keep them synchronized to our CMDB. We obtain reports from the CMDB in CSV format, and link them to Access as well. We then use a combination of Access VBA and predefined queryies to add new data, or update or soft delete existing data. One list in particular is causing problems. Specifically, inserts/soft deletes seem to work, but Access exhausts resources and crashes when running the update query. Pulling up the resource monitor shows that memory usage constantly increases as the application runs, and Access finally fails when ~ 1.6 GB or RAM has been allocated to it (on a 4 GB machine with a 6 GB swap file, Windows 7 64 bit, but 32 bit Access).
I use two queries in addition to the VBA code. One query retrieves a result set that allows me to determine which row in the SharePoint list is to be updated (if any), while the other identifies which columns from the report update corresponding columns in the SharePoint list, the join condition between the linked report and the corresponding list, and the row in SP to be updated, identified by by its composite key. Fairly standard stuff, I think.
We have to use this approach (or one substantially similar) due to the fact that the SharePoint list has associated workflows. We found that if we wrote our SQL to perform standard set-type updates, the updates occurred too quickly, overloading Sharepoint's workflow engine and causing the workflows to fail.
I've tried a number of alternate techniques:
Using a recordset edit/update sequence rather than the query/exec
shown below. That consumes memory even more quickly, and spikes the
CPU to 26% vs. 12%.
As shown in the VBA code below, I've tried closing and reopening the queries every
100 rows, as well as using transactions. Neither technique results in
an improvement.
I've tried disabling then re-enabling and extending Access'
SharePoint caching mechanism, with no success.
I've tried using parameterized queries. This technique does not work
as we must update a number of memo fields, and query parameters max
out at 255 characters.
Running a database compact/repair does not release allocated memory.
This is the VBA code to execute the queries:
Private Sub runUpdt()
Dim oQdfUpdt As DAO.QueryDef
Dim oRs As DAO.Recordset
Dim oWrkSpc As DAO.Workspace
Dim strmsg As String
On Error GoTo Handler
logMsg "Entering method runUpdt in class clsAppFsFin"
Debug.Print "Entering method runUpdt in class clsAppFsFin", Now()
Set oRs = CurrentDb.QueryDefs("slctAppFsFinRowsForUpdt").OpenRecordset(dbOpenDynaset, dbReadOnly)
Set oQdfUpdt = CurrentDb.QueryDefs("updtAppFsFin")
Set oWrkSpc = DBEngine.Workspaces(0)
Do While (Not oRs.EOF)
oWrkSpc.BeginTrans
If (isUpdated(oRs)) Then
oQdfUpdt.Parameters("CHGTXT") = "System Change"
oQdfUpdt.Parameters("CID") = oRs.Fields("RYCID")
oQdfUpdt.Execute
' inserts a row into the flg_is_updt table
oFlgUpdt.insFlgIsUpdt oRs.Fields("RYAID")
ElseIf (oRs.Fields("SPCTX") <> "System NoChange") Then
oQdfUpdt.Parameters("CHGTXT") = "System NoChange"
oQdfUpdt.Parameters("CID") = oRs.Fields("RYCID")
oQdfUpdt.Execute
' inserts a row into the flg_is_updt table
oFlgUpdt.insFlgIsUpdt oRs.Fields("RYAID")
End If
oWrkSpc.CommitTrans
If ((oRs.AbsolutePosition Mod 100 = 0) And (oRs.AbsolutePosition > 0)) Then
strmsg = "Updated " & oRs.AbsolutePosition & " rows. Class: clsAppFsFin, Method: runUpdt."
Debug.Print strmsg, Now()
logMsg strmsg
Dim curFSCID As String
curFSCID = oRs.Fields("RYCID")
oRs.Close
Set oRs = Nothing
oQdfUpdt.Close
Set oQdfUpdt = Nothing
Set oRs = CurrentDb.QueryDefs("slctAppFsFinRowsForUpdt").OpenRecordset
Set oQdfUpdt = CurrentDb.QueryDefs("updtAppFsFin")
oRs.FindFirst "RYCID = '" & curFSCID & "'"
End If
' sleep .1 seconds to avoid overloading the upstream workflow
Sleep SLEEPTIMEINMILLIS
oRs.MoveNext
Loop
strmsg = "Final update count: " & oRs.RecordCount & " rows. Class: clsAppFsFin, Method: runUpdt."
logMsg strmsg
Debug.Print strmsg, Now()
oRs.Close
oQdfUpdt.Close
Set oRs = Nothing
Set oQdfUpdt = Nothing
Debug.Print "Exiting method runUpdt in class clsAppFsFin", Now()
logMsg "Exiting method runUpdt in class clsAppFsFin"
Exit Sub
Handler:
oWrkSpc.Rollback
Debug.Print Err.Number, Err.Description
logError Err.Number, Err.Description
End Sub
Here are the select and update queries executed by the VBA code
Select query:
SELECT APFF.[App ID] AS SPAID,
APFF.Server AS SPHST,
APFF.Directory AS SPDIR,
RAppAH.AppID AS RYAID,
RAppAH.Host AS RYHST,
RAppAH.FSCID AS RYCID
<
snip
>
FROM (AppCert
INNER JOIN AppFileSystemFin AS APFF
ON AppCert.[App ID] = APFF.[App ID])
LEFT JOIN RAppAH
ON APFF.FSCID = RAppAH.FSCID
WHERE APFF.FSCID = [RAppAH].[FSCID]
AND AppCert.State = "8 - Complete"
AND RAppAH.FSCID IS NOT NULL
AND APFF.[Change In SoR - Text] <> "System Remove"
ORDER BY APFF.ID;
Update query:
UPDATE AppFileSystemFin
INNER JOIN RAppAH
ON AppFileSystemFin.FSCID = RAppAH.FSCID
SET AppFileSystemFin.Server = [RAppAH].[Host],
AppFileSystemFin.Directory = [RAppAH].[Directory],
<
snip
>
WHERE AppFileSystemFin.ID = [ID];
The issue is now resolved. In the update query shown above, the line:
WHERE AppFileSystemFin.ID = [ID];
does not refer to Sharepoint's system-generated ID column. Instead, it refers to an internally generated key field that we had to use in order to be able to perform SQL join operations between lists.
The query has been updated to use SharePoint's generated ID column instead. This minor update resolves the memory allocation issue and in turn, allows updates to proceed more quickly - now requiring only about a third of the previous runtime to complete execution.

MS Access run-time error 3259 invalid field data type on alter table

After re-installing my computer completely, suddenly I get this error:
Run-time error 3259 invalid field data type on alter table
when running this query:
ALTER TABLE Invoices ALTER COLUMN ID COUNTER (1, 1) on a MS Access database.
The data type didn't change, actually nothing changed except for the re-install..
The field ID is a Long Integer field that is set to auto increment for every Invoice that the table holds. Since data resides in this table only temporarily I reset the auto increment after every batch. I think it may have something to do with references missing or changed in different versions.. But I can't seem to figure out which one or why..
Do I need to be more explicit in my query? Anyone ever experience this before?
I was having the same problem. I was checking "Hoew to alter the data definition of a linked table" when it occurred to me that I could try changing the field datatype to NUMBER and see if that code worked.
So I changed the code to:
ALTER TABLE XXXXX ALTER COLUMN ID NUMBER
Run the code with no problems! Checked the table design, and the field datatype had changed from Autonumber to Number.
So, I decided to try the original code again:
ALTER TABLE XXXX ALTER COLUMN ID COUNTER (1,1)
and... IT WORKED!!! O.O
I don't understand why... but it worked...
Try changing the datatype to NUMBER via code, run it, then change it back to COUNTER(1,1), and see if you got the error fixed, like mine did...
ALTER COLUMN ID NUMBER worked for me too, but it can be used probably only in case of empty table, otherwise setting back the ID field as Autonumber (ALTER COLUMN ID COUNTER(next ID number here,1)) would not work. At least manually can't be set.
This is .mdb Access 10 (2002) file put in C://directory/ above any user directory, under Windows XP, opened by Runtime 2010. I have never noticed such behavior when it was inside user directory, like My Documents or Desktop, but maybe this is coincidental and it will occur sometime. It happened first time after few years of using this file with that code.
Edited next day:
It seems to be partially explained. The reason is collating order. The database was created and used previously with this setting:
Tools > Options > General > New database sort order > Polish
but in the middletime, this setting in the program was set to > General
And now it displays that error. It can be fixed easily setting back > Polish
and running Compact and Repair database (ALTER COLUMN ID COUNTER begins to work again). I have repeat this few times so far and each time it worked. But with General Compact and repair database doesn't help ever.
This subroutine:
Private Sub IDProperties()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim TableName As String
Dim i As Integer
Dim str As String
TableName = "the name of table"
Set db = CurrentDb()
Set tdf = db.TableDefs(TableName)
For i = 0 To tdf.Fields("ID").Properties.Count - 1
On Error Resume Next
str = str & vbNewLine & tdf.Fields("ID").Properties(i).name
If Err > 0 Then
str = str & vbNewLine & Err.Number & " " & Err.Description
Err.Clear
End If
str = str & " = " & tdf.Fields("ID").Properties(i).Value
If Err > 0 Then str = str & "; " & Err.Number & " " & Err.Description
On Error GoTo 0
Next
Set tdf = Nothing
db.Close
Set db = Nothing
Debug.Print str
End Sub
returns i.e. collating order of the ID field. For tables which return 3259 error with sort order = General, ID CollatingOrder = 1045. If such table is deleted and imported a fresh one, ID CollatingOrder = 1033 and 3259 error does not occur. So it seems, that Access changes collating order of the ID field during import. That would be second way to fix that. Or importing entire database to a fresh file. Third way is copying such table - it apparently changes ID's CollatingOrder too. The best would be changing collating order by VBA, but it is read only property.
Private Sub GetCollatingOrder()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim TableName As String
Set db = CurrentDb()
Set tdf = db.TableDefs("table name")
MsgBox "Collating order" & _
vbNewLine & "- database: " & db.CollatingOrder & _
vbNewLine & "- table: " & tdf.Fields("ID").Properties("CollatingOrder").Value
'or tdf.Fields("ID").CollatingOrder
Set tdf = Nothing
db.Close
Set db = Nothing
End Sub
Only database sort order can be changed:
Application.SetOption "New Database Sort Order", 1033 ' or 1045 for example
but it changes property of someone's database ... And maybe still compact and repair is required.
Edited later:
Now MsgBox shows 1045 for both: General and Polish (and both: db and ID) and stopped displaying error ... Very strange. Maybe because of several compact and repair.
Edited later:
Next day again the same error if New database sort order not changed + Compact and Repair. So General stopped working after rebooting. The CollatingOrder property values in the MsgBox are different for ID and entire database before Compact and Repair, the same after Compact and Repair (preceeded by New database sort order change).
I was having the same problem, and it has been solved by "Compact & Repair" the MS Access database.
Late reply, but others may find this problem too.
By changing
DoCmd.RunSQL "DELETE * FROM YourTable"
CurrentDb.Execute "ALTER TABLE YourTable ALTER COLUMN ID COUNTER(1,1)"
to
DoCmd.RunSQL "DELETE * FROM YourTable"
CurrentDb.Execute "ALTER TABLE YourTable ALTER COLUMN ID COUNTER(1,2)"
Mine did not give an error anymore, and it did "reset" the auto number.
I was having the same problem. Apparently it was because I had created a new table by copying the structure of an existing one that already had an AutoNumber field. For whatever reason it was giving me this error on the copy. It worked after deleting the table and recreating it from scratch.
Microsoft ADO Ext. 2.8 (or 6.0 ?) for DDL and Security (ADOX) works !!
Dim cat As Object
Set cat = CreateObject("ADOX.Catalog") 'late binding instead As ADOX.Catalog or As New ADOX.Catalog to avoid using references to ADOX
cat.ActiveConnection = CurrentProject.Connection
cat.Tables("Your table name").Columns("Your field name").Properties("Seed") = 1
cat.Tables("Your table name").Columns.Refresh
Set cat = Nothing
But it is slow, maybe because of late binding.