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

VbaMs Access

Vba Problem Overview


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:

Screenshot showing Microsoft Office 2010 Service Pack 2 update 448127

How can I successfully run my queries? Should I just uninstall this update?

Vba Solutions


Solution 1 - Vba

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:

Example

Here is a minimal repro example:

  1. Create a new Access database.

  2. Create a new, empty table "Table1" with the default ID field and a Long Integer field "myint".

  3. 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:

Solution 2 - Vba

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).

Solution 3 - Vba

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"

Solution 4 - Vba

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

Solution 5 - Vba

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.

Solution 6 - Vba

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.

Solution 7 - Vba

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

Solution 8 - Vba

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://docs.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.

  1. Install the Windows Update PowerShell Module.

  2. 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.

Solution 9 - Vba

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!

Solution 10 - Vba

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.

Attributions

All content for this solution is sourced from the original question on Stackoverflow.

The content on this page is licensed under the Attribution-ShareAlike 4.0 International (CC BY-SA 4.0) license.

Content TypeOriginal AuthorOriginal Content on Stackoverflow
QuestionZvi RedlerView Question on Stackoverflow
Solution 1 - VbaHeinziView Answer on Stackoverflow
Solution 2 - VbaJoe MarinucciView Answer on Stackoverflow
Solution 3 - VbaGustavView Answer on Stackoverflow
Solution 4 - VbaGrantView Answer on Stackoverflow
Solution 5 - VbaLukeChung-FMSView Answer on Stackoverflow
Solution 6 - VbalauxjpnView Answer on Stackoverflow
Solution 7 - VbaComputerVersteherView Answer on Stackoverflow
Solution 8 - VbaAdamsTipsView Answer on Stackoverflow
Solution 9 - VbaKrishView Answer on Stackoverflow
Solution 10 - VbaChaosbydesignView Answer on Stackoverflow