执行查询DoCmd.RunSQL时出现错误3340查询''已损坏

时间:2019-11-13 07:32:43

标签: vba ms-access

自从安装the windows update for Office 2010 resolving KB 4484127以来,执行包含WHERE子句的查询时出现错误。

例如执行此查询:

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

导致此错误:

  

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

update in question当前仍被安装:

Screenshot showing Microsoft Office 2010 Service Pack 2 update 448127

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

10 个答案:

答案 0 :(得分:91)

摘要

这是known bug,由2019年11月12日发布的Office更新引起。该错误影响Microsoft当前支持的所有Access版本(从Access 2010到365)。

此错误已修复。

  • 如果您使用Office的C2R(即点即用)版本,use "Update now"
    • 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上发布,因此installing all pending Windows Updates应该足够:

示例

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

  1. 创建一个新的Access数据库。
  2. 使用默认ID字段和Long Integer字段“ myint”创建一个新的空表“ Table1”。
  3. 在VBA编辑器的“即时窗口”中执行以下代码:

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

预期结果:该语句成功完成。

实际结果,其中安装了多个错误更新之一:运行时错误3340(“查询”已损坏”)。


相关链接:

答案 1 :(得分:30)

最简单的解决方案

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

我需要应用一种解决方法,但是微软对建议的内容并没有完全感到兴奋-为每个表创建和替换查询。

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

示例:

之前:

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

之后:

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

在多个数据库和应用程序中实现起来应该容易得多(以后回滚)。

答案 2 :(得分:20)

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

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

对于2010、2013和2016 MSI,以及2019批量许可版本以及O365半年频道,此修复程序将在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 error: "Query is corrupt"

答案 3 :(得分:15)

要临时解决此问题,取决于所使用的Access版本:
Access 2010卸载更新KB4484127
Access 2013卸载更新KB4484119
Access 2016卸载更新KB4484113
如果需要,请访问2019(tbc)。从版本1808(内部版本10352.20042)降级到版本1808(内部版本10351.20054)
Office 365 ProPlus从版本1910(内部版本12130.20344)降级到以前的版本,请参阅https://support.microsoft.com/en-gb/help/2770432/how-to-revert-to-an-earlier-version-of-office-2013-or-office-2016-clic

答案 4 :(得分:5)

我们和我们的客户在最近两天为此苦苦挣扎,最后写了一篇论文来详细讨论该问题以及一些解决方案: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)。 / p>

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

答案 5 :(得分:4)

使用以下模块自动实现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 repository上找到最新的代码。

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

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

RemoveWorkaroundForCorruptedQueryIssue()执行相反的操作。

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

(当然,根据您的编码风格,也有可能破坏应用程序中的内容。因此,在确认该修补程序通常对您有效之后,将所有对象导出为文本并使用它绝不是一个坏主意。有些人发现用魔术代替,以确保使用的所有表名都将针对查询而不是表运行。)

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

答案 6 :(得分:3)

用于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

答案 7 :(得分:3)

对于那些希望通过 PowerShell 自动化此过程的人,以下是一些我发现可能有用的链接:

检测并删除有问题的更新

此处https://www.arcath.net/2017/09/office-update-remover提供了一个PowerShell脚本,该脚本可在注册表中搜索特定的Office更新(以kb编号传递),并使用对msiexec.exe的调用将其删除。该脚本从注册表项中解析出两个GUID,以构建命令以删除适当的更新。

我建议进行的一项更改是使用How to uninstall KB4011626 and other Office updates中所述的/REBOOT=REALLYSUPPRESS(附加参考文献:https://docs.microsoft.com/en-us/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 Module
  2. 使用以下命令按KB号隐藏更新:

    隐藏WUUpdate -KBArticleID KB4484127

希望这会对外面的人有所帮助。

答案 8 :(得分:2)

我用辅助函数替换了currentDb.ExecuteDocmd.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.
    '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

现在只需 CTRL + F

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

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

玩得开心!

答案 9 :(得分:0)

好吧,我也将在这里介绍一下,因为即使该错误已得到修复,但该修复仍未在最终用户可能无法更新的各个企业中完全填充(例如我的雇主...)

这是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

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