Desde a instalação da atualização do Windows para o Office 2010, resolvendo o KB 4484127 , recebo um erro ao executar consultas que contêm uma cláusula WHERE.

Por exemplo, executando esta consulta:

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

Resultados neste erro:

Número do erro = 3340 A consulta '' está corrompida

A atualização em questão ainda está instalada:

Como posso executar minhas consultas com êxito? Devo apenas desinstalar esta atualização?

Sumário

Este é um bug conhecido causado pelas atualizações do Office lançadas em 12 de novembro de 2019. O bug afeta todas as versões do Access atualmente suportadas pela Microsoft (do Access 2010 ao 365).

Este bug foi corrigido.

• Se você usa uma versão C2R (Clique para Executar) do Office, use "Atualizar agora" :
  • Access 2010 C2R: corrigido na compilação 7243.5000
  • Access 2013 C2R: corrigido na compilação 5197.1000
  • Access 2016 C2R: corrigido na compilação 12130.20390
  • Access 2019 (v1910): corrigido na compilação 12130.20390
  • Access 2019 (Volume License): Corrigido na compilação 10353.20037
  • Canal mensal do Office 365: corrigido na compilação 12130.20390
  • Office 365 Semestral: Corrigido na Compilação 11328.20480
  • Extensão semestral do Office 365: corrigida na compilação 10730.20422
  • Segmentação semestral do Office 365: corrigida na compilação 11929.20494
• Se você usar uma versão MSI do Office, instale a atualização correspondente à sua versão do Office. Todos esses patches foram lançados no Microsoft Update; portanto, a instalação de todas as atualizações pendentes do Windows deve ser suficiente:
  • MSI do Access 2010: corrigido no KB4484193
  • Access 2013 MSI: corrigido no KB4484186
  • MSI do Access 2016: corrigido no KB4484180

Exemplo

Aqui está um exemplo mínimo de reprodução:

1. Crie um novo banco de dados do Access.
2. Crie uma nova tabela vazia "Table1" com o campo de identificação padrão e um campo Inteiro Longo "myint".

3. Execute o seguinte código na janela Imediata do editor VBA:

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

Resultado esperado : a instrução é concluída com êxito.

Resultado real com uma das atualizações de bugs instaladas: Ocorre um erro de tempo de execução 3340 ("Consulta '' está corrompida").

Links Relacionados:

• Tópico no fórum do MSDN
• Página oficial da Microsoft para este bug

Solução mais simples

Para meus usuários, aguardar quase um mês até 10 de dezembro por uma liberação de correção da Microsoft não é uma opção. Tampouco desinstalar a atualização ofensiva da Microsoft em várias estações de trabalho bloqueadas pelo governo.

Preciso aplicar uma solução alternativa, mas não estou exatamente empolgado com o que a Microsoft sugeriu - criando e substituindo uma consulta para cada tabela.

A solução é substituir o nome da tabela por uma (SELECT * FROM Table)consulta simples diretamente no UPDATEcomando Isso não requer a criação e o salvamento de várias consultas, tabelas ou funções adicionais.

EXEMPLO:

Antes:

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

Depois de:

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

Isso deve ser muito mais fácil de implementar em vários bancos de dados e aplicativos (e reversão posterior).

Este não é um problema de atualização do Windows, mas um problema que foi introduzido com a versão de terça-feira do Patch Patch de novembro. Uma alteração para corrigir uma vulnerabilidade de segurança faz com que algumas consultas legítimas sejam relatadas como corrompidas. Como a mudança foi uma correção de segurança, ela afeta TODAS as compilações do Office, incluindo 2010, 2013, 2016, 2019 e O365.

O bug foi corrigido em todos os canais, mas o tempo de entrega dependerá do canal em que você estiver.

Para compilações de licenças de volume de 2010, 2013 e 2016 MSI e 2019 e o canal semestral da O365, a correção será na compilação de terça-feira de patch de dezembro, 10 de dezembro. Para O365, canal mensal e insiders, isso será corrigido quando o garfo de outubro for lançado, atualmente planejado para 24 de novembro.

Para o canal semestral, o bug foi introduzido em 11328.20468, lançado em 12 de novembro, mas não é lançado para todos de uma vez. Se puder, você pode adiar a atualização até 10 de dezembro.

O problema ocorre para consultas de atualização em uma única tabela com um critério especificado (portanto, outros tipos de consulta não devem ser afetados, nem qualquer consulta que atualize todas as linhas de uma tabela, nem uma consulta que atualize o conjunto de resultados de outra consulta). Dado isso, a solução mais simples na maioria dos casos é alterar a consulta de atualização para atualizar outra consulta que seleciona tudo da tabela, em vez de atualizar a consulta diretamente.

Ou seja, se você tiver uma consulta como:

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

Em seguida, crie uma nova consulta (Consulta1) definida como:

Select * from Table1;

e atualize sua consulta original para:

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

Página oficial: Erro de acesso: "A consulta está corrompida"

Para resolver temporariamente esse problema, depende da versão do Access em uso:
Atualização de desinstalação do Access 2010 KB4484127 Atualização de desinstalação do
Access 2013 KB4484119 Atualização de desinstalação do
Access 2016 KB4484113 Atualização de desinstalação do KB4484113
Access 2019 SE NECESSÁRIO (tbc). Fazer o downgrade da versão 1808 (compilação 10352.20042) para a versão 1808 (compilação 10351.20054) O
Office 365 ProPlus Downgrade da versão 1910 (compilação 12130.20344) para uma compilação anterior, consulte https://support.microsoft.com/en-gb/help/2770432/ como reverter para uma versão anterior do office-2013-or-office-2016-clic

Nós e nossos clientes lutamos com isso nos últimos dois dias e finalmente escrevemos um artigo para discutir o problema em detalhes, juntamente com algumas soluções: http://fmsinc.com/MicrosoftAccess/Errors/query_is_corrupt/

Ele inclui nossas descobertas de que afeta as soluções do Access ao executar consultas de atualização em tabelas locais, tabelas do Access vinculadas e até tabelas do SQL Server vinculadas.

Ele também afeta as soluções que não são do Microsoft Access usando o ACE (Access Database Engine) para conectar-se aos bancos de dados do Access usando o ADO. Isso inclui aplicativos do Visual Studio (WinForm), aplicativos VB6 e até sites que atualizam bancos de dados do Access em máquinas que nunca tiveram o Access ou o Office instalado.

Essa falha pode até afetar aplicativos da Microsoft que usam ACE como PowerBI, Power Query, SSMA etc. (não confirmado) e, é claro, outros programas como Excel, PowerPoint ou Word usando o VBA para modificar os bancos de dados do Access.

Além da desinstalação óbvia das Atualizações de Segurança ofensivas, também incluímos algumas opções quando não é possível desinstalar devido a permissões ou distribuição de aplicativos do Access a clientes externos cujos PCs estão fora de seu controle. Isso inclui alterar todas as consultas de atualização e distribuir os aplicativos do Access usando o Access 2007 (varejo ou tempo de execução), pois essa versão não é afetada pelas atualizações de segurança.

Use o módulo a seguir para implementar automaticamente a solução alternativa sugerida pela Microsoft (usando uma consulta em vez de uma tabela). Como precaução, faça backup do seu banco de dados primeiro.

Use AddWorkaroundForCorruptedQueryIssue()para adicionar a solução alternativa e RemoveWorkaroundForCorruptedQueryIssue()removê-la a qualquer momento.

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

Você pode encontrar o código mais recente no meu repositório GitHub .

AddWorkaroundForCorruptedQueryIssue()adicionará o sufixo _Tablea todas as tabelas que não são do sistema, por exemplo, a tabela IceCreamsseria renomeada para IceCreams_Table.

Também criará uma nova consulta usando o nome da tabela original, que selecionará todas as colunas da tabela renomeada. No nosso exemplo, a consulta seria nomeada IceCreamse executaria o SQL select * from [IceCreams_Table].

RemoveWorkaroundForCorruptedQueryIssue() faz as ações inversas.

Eu testei isso com todos os tipos de tabelas, incluindo tabelas externas não MDB (como o SQL Server). Mas lembre-se de que o uso de uma consulta em vez de uma tabela pode levar à execução de consultas não otimizadas em um banco de dados back-end em casos específicos, especialmente se as consultas originais que usaram as tabelas forem de baixa qualidade ou muito complexas.

(E, é claro, dependendo do seu estilo de codificação, também é possível quebrar as coisas em seu aplicativo. Portanto, depois de verificar se a correção geralmente funciona para você, nunca é uma má idéia exportar todos os seus objetos como texto e usar algumas opções de substituição de localização mágica para garantir que quaisquer ocorrências de nomes de tabelas sejam executadas nas consultas e não nas tabelas.)

No meu caso, essa correção funciona em grande parte sem quaisquer efeitos colaterais, eu só precisava para mudar o nome manualmente USysRibbons_Tablede volta para USysRibbons, como eu não tinha marcado como uma tabela do sistema quando eu criei no passado.

Para aqueles que desejam automatizar esse processo via PowerShell , aqui estão alguns links que achei úteis:

Detectar e remover as atualizações incorretas

Há um script do PowerShell disponível aqui https://www.arcath.net/2017/09/office-update-remover que pesquisa no registro uma atualização específica do Office (transmitida como um número de kb) e a remove usando uma chamada para msiexec.exe. Esse script analisa os dois GUIDs das chaves do Registro para criar o comando e remover a atualização apropriada.

Uma alteração que eu sugeriria seria usar o /REBOOT=REALLYSUPPRESSdescrito em Como desinstalar o KB4011626 e outras atualizações do Office (referência adicional: https://docs.microsoft.com/en-us/windows/win32/msi/uninstalling-patches ). A linha de comando que você está construindo tem a seguinte aparência:

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

O comando para executar o script seria algo como isto:

OfficeUpdateRemover.ps1 -kb 4484127

Impedir a instalação das atualizações

A abordagem recomendada aqui parece estar ocultando a atualização . Obviamente, isso pode ser feito manualmente, mas existem alguns scripts do PowerShell que podem ajudar na automação. Esse link: https://www.maketecheasier.com/hide-updates-in-windows-10/ descreve o processo em detalhes, mas vou resumir aqui.

1. Instale o módulo Windows Update PowerShell .

2. Use o seguinte comando para ocultar uma atualização pelo número de KB:

   Hide-WUUpdate -KBArticleID KB4484127

Espero que isso ajude alguém mais por aí.

Script VBA para solução alternativa do MS:

É recomendável remover a atualização de buggy, se possível (se não tentar o meu código), pelo menos para as versões MSI. Consulte a resposta https://stackoverflow.com/a/58833831/9439330 .

Nas versões CTR (clique para executar), é necessário remover todas as atualizações do Office November, o que pode causar sérios problemas de segurança (não tenho certeza se alguma correção crítica seria removida).

Dos comentários de @ Eric:

• Se você usar Table.Tablenamepara vincular formulários, eles serão desvinculados, pois o nome da tabela anterior agora é um nome de consulta !.
• OpenRecordSet(FormerTableNowAQuery, dbOpenTable) falhará (já que é uma consulta agora, não uma tabela)

Cuidado! Testado rapidamente contra Northwind.accdb no Office 2013 x86 CTR Sem garantia!

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

Para teste:

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

Substituí a função currentDb.Executee Docmd.RunSQLpor uma função auxiliar. Isso pode pré-processar e alterar a instrução SQL se alguma instrução de atualização contiver apenas uma tabela. Eu já tenho uma dualtabela (linha única, coluna única), então fui com a opção fakeTable.

Nota : Isso não altera seus objetos de consulta. Isso ajudará apenas as execuções SQL 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.

Este é apenas um conceito (If it's a single table update modify the sql before execution). Adapte-o conforme suas necessidades. Este método não cria consultas de substituição para cada tabela (que pode ser a maneira mais fácil, mas tem suas próprias desvantagens. Por exemplo, problemas de desempenho)

+ Pontos: Você pode continuar usando esse auxiliar, mesmo após a correção do bug pela Microsoft, ele não mudará nada. Caso o futuro traga outro problema, você estará pronto para o pre-processseu SQL em um só lugar. Não fui para desinstalar o método de atualizações porque isso exige que o acesso do administrador demore muito para obter todos na versão correta, mesmo que você desinstale, a política de grupo de alguns usuários finais instala a atualização mais recente novamente. Você voltou ao mesmo problema.

Se você tiver acesso ao código-fonte use this methode tiver 100% de certeza de que nenhum usuário final está tendo o problema.

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

Agora apenas CTRL+F

Pesquise e substitua docmd.RunSQLporhelper.Execute

Pesquise e substitua [currentdb|dbengine|or your dbobject].executeporhelper.execute

diverta-se!

Ok, também vou comentar aqui, porque, embora esse bug tenha sido corrigido, essa correção ainda não foi preenchida por várias empresas nas quais os usuários finais podem não ser capazes de atualizar (como meu empregador ...)

Aqui está minha solução alternativa DoCmd.RunSQL "UPDATE users SET uname= 'bob' WHERE usercode=1". Basta comentar a consulta incorreta e soltar o código abaixo.

    '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

Não posso dizer que é bonito, mas faz o trabalho.