自从安装Office 2010的Windows更新以解决KB 4484127以来，我在执行包含WHERE子句的查询时遇到错误。

例如，执行以下查询：

DoCmd.RunSQL "update users set uname= 'bob' where usercode=1"

导致此错误：

错误号= 3340查询''已损坏

当前仍在安装有问题的更新：

如何成功运行查询？我应该只卸载此更新吗？

摘要

这是由2019年11月12日发布的Office更新引起的已知错误。该错误会影响Microsoft当前支持的所有Access版本（从Access 2010到365）。

该错误已修复。

• 如果您使用Office的C2R（即点即用）版本，请使用“立即更新”：
  • Access 2010 C2R：在内部版本7243.5000中修复
  • Access 2013 C2R：在内部版本5197.1000中已修复
  • Access 2016 C2R：在内部版本12130.20390中已修复
  • Access 2019（v1910）：在内部版本12130.20390中修复
  • Access 2019（批量许可证）：内部版本10353.20037中已修复
  • Office 365每月频道：在内部版本12130.20390中已修复
  • Office 365半年：在内部版本11328.20480中已修复
  • Office 365半年扩展：在内部版本10730.20422中已修复
  • Office 365半年度定位：在内部版本11929.20494中已修复
• 如果您使用Office的MSI版本，请安装与您的Office版本匹配的更新。所有这些修补程序都已在Microsoft Update上发布，因此安装所有未决的Windows Updates就足够了：
  • Access 2010 MSI：已在KB4484193中修复
  • Access 2013 MSI：已在KB4484186中修复
  • Access 2016 MSI：已在KB4484180中修复

例

这是一个最小的复制示例：

1. 创建一个新的Access数据库。
2. 使用默认ID字段和Long Integer字段“ myint”创建一个新的空表“ Table1”。

3. 在VBA编辑器的“立即窗口”中执行以下代码：

   CurrentDb.Execute "UPDATE Table1 SET myint = 1 WHERE myint = 1"

预期结果：语句成功完成。

安装了多个错误更新之一的实际结果：发生运行时错误3340（“查询”已损坏”）。

相关链接：

• MSDN论坛线程
• 此错误的官方Microsoft页面

最简单的解决方案

对于我的用户，无法等待将近一个月，直到12月10日才能从Microsoft获得修复版本。也没有在几个政府锁定的工作站上卸载有问题的Microsoft更新。

我需要应用一种变通办法，但是Microsoft的建议并不令我感到兴奋-为每个表创建和替换查询。

解决方案是(SELECT * FROM Table)直接在UPDATE命令中用简单查询替换表名。这不需要创建和保存大量其他查询，表或函数。

例：

之前：

UPDATE Table1 SET Field1 = "x" WHERE (Field2=1);  

后：

UPDATE (SELECT * FROM Table1) SET Field1 = "x" WHERE (Field2=1);  

在多个数据库和应用程序中实现起来应该更容易（以后再回滚）。

这不是Windows更新问题，而是11月补丁星期二Office版本引入的问题。修复安全漏洞的更改导致一些合法查询被报告为损坏。由于此更改是一项安全修复程序，因此会影响所有版本的Office，包括2010、2013、2016、2019和O365。

该错误已在所有渠道中得到修复，但是交付时间取决于您所使用的渠道。

对于2010年，2013年和2016年的MSI，2019年的批量许可版本以及O365半年度频道，修复将在12月补丁星期二的版本中于12月10日进行。对于O365，月度频道和内部人士，此问题将得到修复。十月份的叉子发布时，目前计划于11月24日发布。

对于半年频道，该错误是在11328.20468中引入的，该错误已于11月12日发布，但并没有立即向所有人发布。如果可以，您可能要推迟更新到12月10日。

针对具有指定条件的单个表的更新查询会发生此问题（因此，不应影响其他类型的查询，也不应影响更新表的所有行的任何查询，也不应影响更新另一个查询的结果集的查询）。鉴于此，在大多数情况下，最简单的解决方法是将更新查询更改为更新另一个从表中选择所有内容的查询，而不是直接更新查询。

即，如果您有类似的查询：

UPDATE Table1 SET Table1.Field1 = "x" WHERE ([Table1].[Field2]=1);

然后，创建一个新查询（Query1），定义为：

Select * from Table1;

并将您的原始查询更新为：

UPDATE Query1 SET Query1.Field1 = "x" WHERE ([Query1].[Field2]=1);

官方页面：访问错误：“查询已损坏”

要临时解决此问题，取决于所使用的Access版本：
Access 2010卸载更新KB4484127
Access 2013卸载更新KB4484119
Access 2016卸载更新KB4484113
如果需要，请访问Access 2019（tbc）。从版本1808（内部版本10352.20042）降级到版本1808（内部版本10351.20054）
Office 365 ProPlus从版本1910（内部版本12130.20344）降级到以前的版本，请参阅https://support.microsoft.com/en-gb/help/2770432/如何还原到早期版本的Office 2013或Office 2016 CLIC

我们和我们的客户在最近两天为此苦苦挣扎，最后写了一篇论文来详细讨论该问题以及一些解决方案：http : //fmsinc.com/MicrosoftAccess/Errors/query_is_corrupt/

它包括我们的发现，当对本地表，链接的Access表甚至链接的SQL Server表运行更新查询时，它会影响Access解决方案。

它还会影响使用Access数据库引擎（ACE）连接到使用ADO的Access数据库的非Microsoft Access解决方案。其中包括Visual Studio（WinForm）应用程序，VB6应用程序，甚至包括在未安装Access或Office的计算机上更新Access数据库的网站。

此崩溃甚至可能影响使用ACE的Microsoft应用程序（例如PowerBI，Power Query，SSMA等）（未确认），当然还会影响其他使用VBA修改Access数据库的程序（例如Excel，PowerPoint或Word）。

除了明显卸载有问题的安全更新外，当由于权限或将Access应用程序分发给您的PC无法控制的外部客户而无法卸载时，我们还提供了一些选项。这包括更改所有Update查询，以及使用Access 2007（零售版或运行时）分发Access应用程序，因为该版本不受安全更新的影响。

使用以下模块自动实现Microsoft建议的解决方法（使用查询而不是表）。作为预防措施，请首先备份数据库。

使用AddWorkaroundForCorruptedQueryIssue()添加的解决办法，并RemoveWorkaroundForCorruptedQueryIssue()随时将其删除。

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

您可以在我的GitHub存储库中找到最新的代码。

AddWorkaroundForCorruptedQueryIssue()会将后缀添加_Table到所有非系统表中，例如，该表IceCreams将重命名为IceCreams_Table。

它还将使用原始表名创建一个新查询，该查询将选择重命名表的所有列。在我们的示例中，查询将被命名IceCreams并执行SQL select * from [IceCreams_Table]。

RemoveWorkaroundForCorruptedQueryIssue() 进行相反的动作。

我用各种表（包括外部非MDB表（如SQL Server））对此进行了测试。但是请注意，在特定情况下，使用查询代替表可能会导致针对后端数据库执行未优化的查询，尤其是当使用表的原始查询的质量很差或非常复杂时。

（当然，根据您的编码风格，也有可能破坏应用程序中的内容。因此，在确认该修补程序通常对您有用之后，将所有对象导出为文本并使用一些find replace并不是一个坏主意。确保使用任何出现的表名的魔力都将针对查询而不是表运行）。

就我而言，此修复程序在很大程度上没有任何副作用，我只需要手动将其重命名USysRibbons_Table为USysRibbons，因为我在过去创建它时并未将其标记为系统表。

对于那些希望通过PowerShell 自动化此过程的人，这里有一些我发现可能有用的链接：

检测并删除有问题的更新

https://www.arcath.net/2017/09/office-update-remover此处提供PowerShell脚本，该脚本在注册表中搜索特定的Office更新（以kb编号传递），并通过调用来删除它msiexec.exe。该脚本从注册表项中解析出两个GUID，以构建命令以删除适当的更新。

我建议使用的一种更改，/REBOOT=REALLYSUPPRESS如如何卸载KB4011626和其他Office更新中所述（其他参考：https : //docs.microsoft.com/zh-cn/windows/win32/msi/uninstalling-patches）。您正在构建的命令行如下所示：

msiexec /i {90160000-0011-0000-0000-0000000FF1CE} MSIPATCHREMOVE={9894BF35-19C1-4C89-A683-D40E94D08C77} /qn REBOOT=REALLYSUPPRESS

运行脚本的命令如下所示：

OfficeUpdateRemover.ps1 -kb 4484127

阻止安装更新

这里推荐的方法似乎是隐藏更新。显然，这可以手动完成，但是有一些PowerShell脚本可以帮助实现自动化。该链接：https : //www.maketecheasier.com/hide-updates-in-windows-10/详细描述了该过程，但我将在此处进行总结。

1. 安装Windows Update PowerShell模块。

2. 使用以下命令按KB号隐藏更新：

   Hide-WUUpdate -KBArticleID KB4484127

希望这将对其他人有所帮助。

MS解决方案的VBA脚本：

建议至少在MSI版本中删除有问题的更新（如果可能的话，请尝试尝试删除我的代码）。请参阅答案https://stackoverflow.com/a/58833831/9439330。

对于CTR（即点即用）版本，您必须删除所有Office November更新，这可能会导致严重的安全问题（不确定是否会删除任何重要的修复程序）。

来自@Eric的评论：

• 如果Table.Tablename用于绑定表单，则它们将不受约束，因为以前的表名现在是查询名！
• OpenRecordSet(FormerTableNowAQuery, dbOpenTable) 将会失败（因为它现在是一个查询，不再是一个表）

警告！只是在Office 2013 x86 CTR上针对Northwind.accdb进行了快速测试没有担保！

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

用于检测：

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

我用辅助函数替换了currentDb.Execute和Docmd.RunSQL。如果任何更新语句仅包含一个表，则可以预处理和更改SQL语句。我已经有一个dual（单行，单列）表，所以我使用了fakeTable选项。

注意：这不会更改您的查询对象。它只会帮助通过VBA执行SQL。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.

这只是一个概念(If it's a single table update modify the sql before execution)。根据您的需要进行调整。此方法不会为每个表创建替换查询（这可能是最简单的方法，但有其自身的缺点，即性能问题）。

+点：即使在MS修复了该错误之后， 您仍然可以继续使用此帮助程序，该错误不会改变任何内容。万一将来会带来另一个问题，您已经准备好在pre-process一个地方使用SQL。我没有使用卸载更新方法，因为这需要管理员访问权限+花费太长时间才能使每个人都获得正确的版本+即使您进行了卸载，某些最终用户的组策略也会再次安装最新的更新。您又回到了同样的问题。

如果您有权访问源代码，use this method并且100％确保没有最终用户遇到此问题。

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.
    '/programming/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

现在只要CTRL+F

搜索并替换docmd.RunSQL为helper.Execute

搜索并替换[currentdb|dbengine|or your dbobject].execute为helper.execute

玩得开心！

好的，我也将在这里提出建议，因为即使此错误已得到修复，但该修复仍未在最终用户可能无法更新的各个企业中完全填充（例如我的雇主...）

这是我的解决方法DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1"。只需注释掉有问题的查询并放入下面的代码即可。

    '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

我不能说很漂亮，但是可以完成工作。