Erro de sintaxe (operador faltando) vba outlook

Pessoal, bom dia.

Tenho um código (abaixo) que está apresentando o seguinte erro:

"Erro de sintaxe (operador faltando) na expressão de consulta "Mc Donald's"

Já é a segunda vez que dá esse mesmo erro e eu acredito que seja em razão do apóstrofe...porém não sei como corrigir..

Alguém consegue me ajudar, por favo?

O erro sempre da na linha :  objConnection.Execute strSQL

Segue o código:

Option Explicit

Sub CustomMailMessageRule_GeraP(Item As Outlook.MailItem)  'CustomMailMessageRule
'****************************************************************************
'Gera protocolo para as mensagens recebidas
'****************************************************************************
   Dim strConnectString        As String
   Dim objConnection           As ADODB.Connection
   Dim strDbPath               As String
   Dim strSQL                  As String
   Dim rs                      As New ADODB.Recordset
   Dim mProtocolo              As String
   Dim mEnvio                  As Long
   Dim nP                      As Long
   Dim mProcesso As String
   Dim mPasta                  As Outlook.Folder

   If (Left(Item.Subject, 5) = "Lida: " And Left(Item.Body, 25) = "Sua mensagem foi lida em ") Or _
      (Left(Item.Subject, 10) = "Entregue: " And Left(Item.Body, 54) = "Sua mensagem foi entregue aos seguintes destinatários:") Or _
      (Left(Item.Subject, 21) = "Ausência Temporária: ") Or _
      (Left(Item.Subject, 25) = "Não foi possível enviar: " And InStr(1, Item.Sender, "MicrosoftExchange") > 0) _
      Then
'        Item.Subject = Item.Subject & " - sem protocolo"
'        Item.Save
       Exit Sub
   End If
   
   strDbPath = "\\fswcorp\ceic\SNL\COMUM\Atendimento\Controle_Suporte_v1.accdb"
   strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & ";"

   Set objConnection = New ADODB.Connection
   objConnection.Open strConnectString
   
'**Define o número do protocolo (Ano, Mês, Número crescente de 4 dígitos) e o número do envio**
   'Verifica se já tem numero de protocolo no assunto e guarda sua posição, se houver
   nP = InStr(1, Item.Subject, "Protocolo: ")
   If nP = 0 Then 'Primeiro envio da mensagem (não tem protocolo)
       rs.Open "Select TOP 1 Protocolo, Envio FROM tbLogSuporte ORDER BY Protocolo DESC, Envio DESC;", objConnection, adOpenForwardOnly, adLockReadOnly
       If Not rs.EOF Then
           If Left(rs!Protocolo, 6) = Year(Now()) & Format(Month(Now()), "00") Then 'Testa se mudou o mês
               mProtocolo = Year(Now()) & Format(Month(Now()), "00") & Format(Right(rs!Protocolo, 4) + 1, "0000")
           Else
               mProtocolo = Year(Now()) & Format(Month(Now()), "00") & "0001"
           End If
       Else
           mProtocolo = Year(Now()) & Format(Month(Now()), "00") & "0001"
       End If
       rs.Close
       mEnvio = 1
       
       'Insere o número de protocolo no assunto do email
       Item.Subject = Item.Subject & " - Protocolo: " & mProtocolo
       Item.Save
       
   Else 'Mensagem está sendo reenviada (já tem protocolo)
       mProtocolo = Mid(Item.Subject, nP + 11, 10)
       
       strSQL = "Select TOP 1 Protocolo, Envio FROM tbLogSuporte WHERE Protocolo = '" & mProtocolo & "' "
       strSQL = strSQL & "ORDER BY Envio DESC;"
       rs.Open strSQL, objConnection, adOpenForwardOnly, adLockReadOnly
       mEnvio = rs!Envio + 1
       rs.Close
   End If
   
   'Consulta relação de palavras chaves e pastas
   strSQL = "Select Palavra_Chave, Pasta FROM tbClassificacao ORDER BY Ordem;"
   rs.Open strSQL, objConnection, adOpenForwardOnly, adLockReadOnly
   'Busca palavras chaves no assunto e no corpo do email e determina a pasta destino
   mProcesso = ""
   Do Until rs.EOF
       If InStr(1, Item.Subject, rs!Palavra_Chave, vbTextCompare) Then
          ' InStr(1, Item.Body, rs!Palavra_Chave, vbTextCompare) Then
           mProcesso = rs!Pasta
           Exit Do
       End If
       rs.MoveNext
   Loop
   rs.Close
   
   'Grava Log de recepção da mensagem
   strSQL = "INSERT INTO tbLogSuporte (Protocolo, Envio, DataHora_Rec, Demandante, Processo, Assunto) VALUES ('" & _
   mProtocolo & "','" & _
   mEnvio & "', #" & _
   Now() & "#, '" & _
   Item.Sender & "', '" & _
   mProcesso & "', '" & _
   Left(Item.Subject, 255) & "');"
   objConnection.Execute strSQL
   
   'Move mensagem para pasta especificada. Caso não tenha encontrado palavra chave, deixa na caixa de entrada
   If mProcesso <> "" Then
       Set mPasta = Application.GetNamespace("MAPI").Folders("Numerario@correio.itau.com.br"). _
                   Folders("Demandas Numerario").Folders(mProcesso)
       Item.Move mPasta
   End If
   
   Set objConnection = Nothing
 
End Sub