当前位置：theitroad>vba 执行查询 DoCmd.RunSQL 时出现错误 3340 查询“ ”已损坏

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

声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow 原文地址: http://stackoverflow.com/questions/58832269/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-08 10:58:42 　来源:igfitidea点击:

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

vbams-access

提问by Zvi Redler

Since installing the windows update for Office 2010 resolving KB 4484127I get an error while executing queries which contain a WHERE clause.

由于为 Office 2010安装Windows 更新解决 KB 4484127，我在执行包含 WHERE 子句的查询时出错。

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

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

The update in questionis currently still installed:

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

Screenshot showing Microsoft Office 2010 Service Pack 2 update 448127

显示 Microsoft Office 2010 Service Pack 2 更新 448127 的屏幕截图

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

如何成功运行我的查询？我应该卸载这个更新吗？

回答by Heinzi

Summary

概括

This is a known bugcaused 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).

这是由 2019 年 11 月 12 日发布的 Office 更新引起的已知错误。该错误影响 Microsoft 当前支持的所有 Access 版本（从 Access 2010 到 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 Updatesshould suffice:
  • 如果您使用的是 C2R（即点即用）版本的 Office，请使用“立即更新”：
    • Access 2010 C2R：在 Build 7243.5000 中修复
    • Access 2013 C2R：在 Build 5197.1000 中修复
    • Access 2016 C2R：在 Build 12130.20390 中修复
    • Access 2019 (v1910)：在 Build 12130.20390 中修复
    • Access 2019（批量许可）：在 Build 10353.20037 中修复
    • Office 365 每月频道：已在内部版本 12130.20390 中修复
    • Office 365 半年版：已在内部版本 11328.20480 中修复
    • Office 365 半年扩展版：已在内部版本 10730.20422 中修复
    • Office 365 半年目标：已在内部版本 11929.20494 中修复
  • 如果您使用 MSI 版本的 Office，请安装与您的 Office 版本匹配的更新。所有这些补丁都已在 Microsoft Update 上发布，因此安装所有待处理的 Windows 更新就足够了：

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"

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

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

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

Expected result: The statement successfully finishes.

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

Actual resultwith one of the buggy updates installed: Run-time error 3340 occurs ("Query '' is corrupt").

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

Related links:

相关链接：

回答by Joe Marinucci

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.

对于我的用户来说，等待近一个月直到 12 月 10 日才能从 Microsoft 发布修复程序是不可行的。也不是在多个政府锁定的工作站上卸载有问题的 Microsoft 更新。

I need to apply a workaround, but am not exactly thrilled with what Microsoft suggested - creating and substituting a query for each table.

我需要应用一种解决方法，但我对 Microsoft 的建议并不十分满意——为每个表创建和替换一个查询。

The solution is to replace the Table name with a simple (SELECT * FROM Table)query directly in the UPDATEcommand. This does not require creating and saving a ton of additional queries, tables, or functions.

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

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

这应该更容易跨多个数据库和应用程序实现（以及稍后回滚）。

回答by Gustav

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.

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

对于 2010、2013 和 2016 MSI 和 2019 批量许可证版本以及 O365 半年频道，修复将在 12 月 10 日星期二补丁中修复。对于 O365、月度频道和 Insiders，这将被修复当 10 月分叉发布时，目前计划在 11 月 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.

对于半年频道，该错误是在 11328.20468 中引入的，该错误于 11 月 12 日发布，但并未立即向所有人推出。如果可以，您可能希望将更新推迟到 12 月 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:

然后，创建一个定义为的新查询 (Query1)： 

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"

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

回答by Grant

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

临时解决此问题取决于所使用的 Access 版本：
Access 2010 卸载更新 KB4484127
Access 2013 卸载更新 KB4484119
Access 2016 卸载更新 KB4484113
Access 2019 IF REQUIRED (tbc)。从版本 1808（内部版本 10352.20042）降级到版本 1808（内部版本 10351.20054）
Office 365 专业增强版从版本 1910（内部版本 12130.20344）降级到以前的版本，请参阅https://support.microsoft.com/en-gb2/en-gb/如何恢复到早期版本的 Office-2013-or-office-2016-clic

回答by LukeChung-FMS

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/

我们和我们的客户在过去两天一直在努力解决这个问题，最后写了一篇论文详细讨论了这个问题以及一些解决方案：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.

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

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.

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

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.

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

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.

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

回答by lauxjpn

Use the following module to automatically implement Microsofts suggested workaround (using a query instead of a table). As a precaution, backup your database first.

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

Use AddWorkaroundForCorruptedQueryIssue()to add the workaround and RemoveWorkaroundForCorruptedQueryIssue()to remove it at any time.

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

You can find the latest code on my GitHub repository.

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

AddWorkaroundForCorruptedQueryIssue()will add the suffix _Tableto all non-system tables, e.g. the table IceCreamswould be renamed to IceCreams_Table.

AddWorkaroundForCorruptedQueryIssue()会将后缀添加_Table到所有非系统表，例如，该表IceCreams将重命名为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 IceCreamsand would execute the SQL select * from [IceCreams_Table].

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

RemoveWorkaroundForCorruptedQueryIssue()does the reverse actions.

RemoveWorkaroundForCorruptedQueryIssue()做相反的动作。

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.

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

(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_Tableback to USysRibbons, as I hadn't marked it as a system table when I created it in the past.

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

回答by ComputerVersteher

VBA-Script for MS-Workaround:

MS-Workaround 的 VBA 脚本：

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.

如果可能（如果没有尝试我的代码），至少对于 MSI 版本，建议删除有问题的更新。请参阅答案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).

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

From @Eric's comments:

来自@Eric 的评论：

  • 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)
  • 如果您使用Table.Tablename绑定表单，它们将被取消绑定，因为以前的表名现在是查询名！。
  • OpenRecordSet(FormerTableNowAQuery, dbOpenTable)将失败（现在是查询，不再是表）

Caution!Just quick tested against Northwind.accdbon Office 2013 x86 CTR No Warranty!

警告！刚刚在 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

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

回答by AdamsTips

For those looking to automatethis process via PowerShell, here are a few links I found that may be helpful:

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

Detect and Remove the Offending Updates

检测并删除违规更新

There is a PowerShell script available here https://www.arcath.net/2017/09/office-update-removerthat 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.

此处有一个 PowerShell 脚本https://www.arcath.net/2017/09/office-update-remover可在注册表中搜索特定的 Office 更新（作为 kb 编号传入）并使用调用将其删除msiexec.exe. 此脚本从注册表项中解析出两个 GUID，以构建删除相应更新的命令。

One change that I would suggest would be using the /REBOOT=REALLYSUPPRESSas 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:

一个变化，我会建议将被使用/REBOOT=REALLYSUPPRESS在描述如何卸载KB4011626和其他Office更新（附加参考：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

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.

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

  1. Install the Windows Update PowerShell Module.

  2. Use the following command to hide an update by KB number:

    Hide-WUUpdate -KBArticleID KB4484127

  1. 安装Windows 更新 PowerShell 模块。

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

    Hide-WUUpdate -KBArticleID KB4484127

Hopefully this will be a help to someone else out there.

希望这对其他人有帮助。

回答by Krish

I replaced the currentDb.Executeand Docmd.RunSQLwith 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.

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

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.

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

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)

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

+Points:You can continueto 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-processyour SQL in one place. I didn't go for uninstalling updatesmethod 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.

+Points：即使在 MS 修复了错误后， 您仍可以继续使用此助手，它不会改变任何内容。万一未来带来另一个问题，您可以pre-process在一个地方准备好您的 SQL。我没有选择卸载更新方法，因为这需要管理员访问权限 + 需要很长时间才能让每个人都使用正确的版本 + 即使您卸载，某些最终用户的组策略也会再次安装最新更新。你又回到了同样的问题。

If you have access to the source-code, use this methodand you are 100% sure that no enduser is having the issue.

如果您可以访问源代码，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

Now just CTRL+F

现在只需CTRL+F

Search and replace docmd.RunSQLwith helper.Execute

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

Search and replace [currentdb|dbengine|or your dbobject].executewith helper.execute

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

have fun!

玩得开心！

回答by Chaosbydesign

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"。只需注释掉有问题的查询并放入下面的代码即可。

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

我不能说它很漂亮，但它完成了工作。

相关推荐

在 VBA 中查找 Excel 工作表的底部

在 VBA 中查找 Excel 工作表的底部

Excel vba 从日期对象中获取月份

Excel vba 从日期对象中获取月份

vba 存在空数组时处理错误 9

vba 存在空数组时处理错误 9

VBA 通过单击按钮创建一个新工作簿

VBA 通过单击按钮创建一个新工作簿

相关推荐
最近更新
标签