クエリDoCmd.RunSQLの実行中にエラー3340クエリ ''が壊れています

Question

インストール後 Office 2010のWindowsアップデートでKB 4484127を解決 WHERE句を含むクエリの実行中にエラーが発生します。

たとえば、次のクエリを実行します。

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

このエラーの結果：

エラー番号= 3340クエリ ''が壊れています

問題の更新 は現在もインストールされています。

クエリを正常に実行するにはどうすればよいですか？この更新プログラムをアンインストールする必要がありますか？

Answer 1

概要

これは 既知のバグ 2019年11月12日にリリースされたOfficeの更新が原因です。このバグは、Microsoftが現在サポートしているAccessのすべてのバージョン（Access 2010から365）に影響します。

このバグは修正されました。

• C2R（Click-to-Run）バージョンのOfficeを使用している場合 「今すぐ更新」を使用 ：
  • 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 Monthly Channel：ビルド12130.20390で修正済み
  • Office 365半年：ビルド11328.20480で修正済み
  • Office 365半期延長：ビルド10730.20422で修正
  • Office 365半期ターゲット：ビルド11929.20494で修正済み
• MSIバージョンのOfficeを使用している場合は、Officeバージョンに一致するアップデートをインストールしてください。これらのパッチはすべてMicrosoft Updateでリリースされているため、 保留中のすべてのWindows Updateをインストール で十分です：
  • Access 2010 MSI：修正済み KB448419
  • Access 2013 MSI：修正済み KB4484186
  • Access 2016 MSI：修正済み KB448418

---

例

これは最小限の再現例です：

1. 新しいAccessデータベースを作成します。
2. デフォルトのIDフィールドとLong Integerフィールド「myint」を使用して、新しい空のテーブル「Table1」を作成します。

3. VBAエディターのイミディエイトウィンドウで次のコードを実行します。

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

期待される結果：ステートメントは正常に終了します。

バグのあるアップデートの1つがインストールされた実際の結果：実行時エラー3340が発生します（「クエリ ''が壊れています」）。

---

関連リンク：

• MSDNフォーラムスレッド
• このバグの公式Microsoftページ

Answer 2

最も簡単なソリューション

ユーザーにとって、マイクロソフトからの修正リリースを12月10日まで1か月近く待つことはオプションではありません。いくつかの政府のロックされたワークステーションから問題のあるMicrosoftアップデートをアンインストールすることもありません。

回避策を適用する必要がありますが、Microsoftの提案（各テーブルのクエリの作成と置換）にはまったくわくわくしません。

解決策は、UPDATEコマンドでテーブル名を単純な(SELECT * FROM Table)クエリに直接置き換えることです。これには、大量の追加のクエリ、テーブル、または関数を作成して保存する必要はありません。

例：

前：

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

後：

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

これは、複数のデータベースやアプリケーションに実装するのがはるかに簡単です（後でロールバックする必要があります）。

Answer 3

これはWindowsの更新の問題ではなく、11月のパッチ火曜日のOfficeリリースで発生した問題です。セキュリティの脆弱性を修正するための変更により、一部の正当なクエリが破損していると報告されます。この変更はセキュリティ修正であったため、2010、2013、2016、2019、O365など、Officeのすべてのビルドに影響します。

バグはすべてのチャネルで修正されていますが、配信のタイミングは、使用しているチャネルによって異なります。

2010、2013、2016 MSI、2019ボリュームライセンスビルド、およびO365半年チャネルの場合、修正は12月10日パッチ火曜日ビルド、12月10日に予定されています。O365、月次チャネル、およびInsiderの場合、これは修正されます10月のフォークがリリースされたとき、現在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);

公式ページ： アクセスエラー：「クエリが壊れています」

Answer 4

この問題を一時的に解決するには、使用しているAccessのバージョンによって異なります。
Access 2010アンインストールアップデートKB4484127
Access 2013アンインストール更新プログラムKB4484119
Access 2016アンインストールアップデートKB4484113
2019年の必要な場合はアクセス（tbc）。バージョン1808（ビルド10352.20042）からバージョン1808（ビルド10351.20054）へのダウングレード
Office 19 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

Answer 5

私たちとクライアントは過去2日間でこれに苦労しており、最後にいくつかの解決策と一緒に問題を詳細に説明するための論文を書きました： http://fmsinc.com/MicrosoftAccess/Errors/query_is_corrupt/

ローカルテーブル、リンクされたAccessテーブル、さらにはリンクされたSQL Serverテーブルで更新クエリを実行すると、Accessソリューションに影響を与えるという調査結果が含まれています。

また、ADOを使用してAccessデータベースに接続するためにAccess Database Engine（ACE）を使用するMicrosoft以外のAccessソリューションにも影響します。これには、Visual Studio（WinForm）アプリ、VB6アプリ、およびAccessまたはOfficeがインストールされていないマシンのAccessデータベースを更新するWebサイトも含まれます。

このクラッシュは、PowerBI、Power Query、SSMAなどのACEを使用するMicrosoftアプリ（確認されていません）、およびもちろん、VBAを使用してAccessデータベースを変更するExcel、PowerPoint、Wordなどの他のプログラムにも影響を与える可能性があります。

問題のあるセキュリティ更新プログラムの明らかなアンインストールに加えて、アクセス権が原因でアンインストールできない場合や、PCの制御が及ばない外部顧客にAccessアプリケーションを配布する場合のオプションも含まれています。これには、すべての更新クエリの変更とAccess 2007（小売またはランタイム）を使用したAccessアプリケーションの配布が含まれます。これは、そのバージョンがセキュリティ更新の影響を受けないためです。

Answer 6

次のモジュールを使用して、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など）を含むすべての種類のテーブルでこれをテストしました。ただし、特定の場合、特にテーブルを使用した元のクエリの品質が低いか非常に複雑な場合、テーブルの代わりにクエリを使用すると、最適化されていないクエリがバックエンドデータベースに対して実行される可能性があることに注意してください。

（そしてもちろん、コーディングスタイルによっては、アプリケーションで問題が発生する可能性もあります。そのため、修正が一般的に機能することを確認した後、すべてのオブジェクトをテキストとしてエクスポートして検索置換を使用することは決して悪い考えではありませんテーブル名の出現がクエリではなくテーブルに対して実行されることを保証する魔法。）

私の場合、この修正はほとんど副作用なしで機能します。手動で_USysRibbons_Table_をUSysRibbonsに名前を変更する必要がありました。過去。

Answer 7

自動化PowerShellを介してこのプロセスを探している人のために、役立つと思われるいくつかのリンクを次に示します：

問題のある更新を検出して削除する

ここに利用可能なPowerShellスクリプトがあります https://www.arcath.net/2017/09/office-update-remover レジストリを検索して特定のOffice更新プログラム（KB番号として渡されます）を検索しますmsiexec.exeの呼び出しを使用して削除します。このスクリプトは、レジストリキーから両方のGUIDを解析して、適切な更新を削除するコマンドを作成します。

KB4011626およびその他のOfficeの更新プログラムをアンインストールする方法 （追加の参照： https://docs.Microsoft.com/en-us）で説明されている/REBOOT=REALLYSUPPRESSを使用することをお勧めします。/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番号で更新を非表示にします。

   Hide-WUUpdate -KBArticleID KB4484127

うまくいけば、これは他の誰かの助けになるでしょう。

Answer 8

MS-回避策のVBAスクリプト：

少なくともMSIバージョンについては、可能であれば（私のコードを試さない限り）バグのあるアップデートを削除することをお勧めします。回答 https://stackoverflow.com/a/58833831/94393 を参照してください。

CTR（Click-To-Run）バージョンの場合、深刻なセキュリティ問題を引き起こす可能性のあるすべてのOffice November-Updatesを削除する必要があります（重要な修正が削除されるかどうかは不明です）。

@Ericのコメントから：

• _Table.Tablename_を使用してフォームをバインドすると、以前のtable-nameがquery-name！になるため、バインドが解除されます。
• 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
_

Answer 9

currentDb.ExecuteおよびDocmd.RunSQLヘルパー関数付き。いずれかの更新ステートメントにテーブルが1つしか含まれていない場合、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)。必要に応じて調整してください。このメソッドは、各テーブルの置換クエリを作成しません（これは最も簡単な方法ですが、独自の欠点があります。つまり、パフォーマンスの問題です）。

+ Points： MSがバグを修正した後でも、このヘルパーを使用してcontinueを変更することはできません。将来的に別の問題が発生した場合に備えて、pre-process SQLを1か所に。私はアップデートのアンインストールメソッドを使用しませんでした。これは、管理者アクセスが必要+正しいバージョンで全員を取得するには時間がかかりすぎる+アンインストールした場合でも、一部のエンドユーザーのグループポリシーが最新のアップデートを再度インストールするためです。同じ問題に戻ります。

ソースコードにアクセスできる場合は、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

楽しんで！

Answer 10

このバグも修正されましたが、エンドユーザーが更新できない可能性のあるさまざまな企業（雇用主など）にはまだ修正が反映されていないので、ここでもチャイムを鳴らします。

これが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

きれいだとは言えませんが、仕事はうまくいきます。