Interação com Outlook

Pessoal, boa tarde!

Estou precisando da ajuda dos senhores, tenho o código abaixo que move os emails entre pastas do outlook conforme a categorizacao no sistema pelos usuários.

O código está funcionando em 3 computadores difetentes, mas quando tento rodar em um outro computador ele não roda até o final.

Alguém poderia me ajudar???

Código:

Public Function MoverEmails()
      
    Dim dbBase As DAO.Database
    Dim myBase As DAO.Recordset
    Dim vSQL As String: vSQL = "SELECT tbBase.Chave, tbBase.De, tbBase.Assunto, tbBase.[Assunto normalizado],tbBase.[Conteúdos], tbBase.Criado, tbBase.Categoria, tbBase.Chave2 " _
                             & "From tbBase " _
                             & "WHERE (((tbBase.Categoria) Like 'ARQUIVAR' Or (tbBase.Categoria) Like 'DESCARTAR' Or (tbBase.Categoria) Like 'RETORNO' Or (tbBase.Categoria) Like 'CÓPIA' Or (tbBase.Categoria) Like 'INTERNO'));"
        Set dbBase = CurrentDb
        Set myBase = CurrentDb.OpenRecordset(vSQL)
    
        Do While Not myBase.EOF

            Dim myOlApp As New Outlook.Application
            Dim myNamespace As Outlook.NameSpace
            Dim myInbox As Outlook.Folder
            Dim myDestFolderArquivados, myDestFolderDescartados, myDestFolderRetornos, myDestFolderInternos As Outlook.Folder
            Dim myItems As Outlook.Items
            Dim myRestrictItems As Outlook.Items
            Dim myItem As Outlook.MailItem
            Dim rotina, x, i As Integer
            Dim chavepesquisa, chaveemail As String
            
            
            Set myNamespace = myOlApp.GetNamespace("MAPI")
            Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox).Folders("SAJ").Folders("1_INPUTS")

            Set myItems = myInbox.Items
            Set myDestFolderArquivados = myNamespace.GetDefaultFolder(olFolderInbox).Folders("SAJ").Folders("ARQUIVADOS") 'myInbox.Folders("Importados")
            Set myDestFolderDescartados = myNamespace.GetDefaultFolder(olFolderInbox).Folders("SAJ").Folders("DESCARTADOS") 'myInbox.Folders("Importados")
            Set myDestFolderRetornos = myNamespace.GetDefaultFolder(olFolderInbox).Folders("SAJ").Folders("2_RETORNOS")
            Set myDestFolderInternos = myNamespace.GetDefaultFolder(olFolderInbox).Folders("SAJ").Folders("3_INTERNOS")
            Set myItem = myItems.GetFirst
                    
                Set myRestrictItems = myItems.Restrict("[SenderName] = '" & myBase.Fields("De") & "'") ' Criterio pelo Remetente

                If myRestrictItems.Count = 0 Then GoTo jump
                
                For i = myRestrictItems.Count To 1 Step -1
                
                    chavepesquisa = myBase.Fields("Chave")
                    chaveemail = myRestrictItems(i).SenderName & Trim(Replace(myRestrictItems(i).Subject, "[External]", "")) & Left(myRestrictItems(i).body, 20)
                    
                    If chavepesquisa = chaveemail Then
                        If myBase.Fields("Categoria") = "ARQUIVAR" Then
                            myRestrictItems(i).Move myDestFolderArquivados
                                ElseIf myBase.Fields("Categoria") = "CÓPIA" Then
                                myRestrictItems(i).Move myDestFolderDescartados
                                    ElseIf myBase.Fields("Categoria") = "DESCARTAR" Then
                                        myRestrictItems(i).Move myDestFolderDescartados
                                            ElseIf myBase.Fields("Categoria") = "RETORNO" Then
                                            myRestrictItems(i).Move myDestFolderRetornos
                                                ElseIf myBase.Fields("Categoria") = "INTERNO" Then
                                                myRestrictItems(i).Move myDestFolderInternos
                        End If
                    End If
                Next
        
jump:

            Set myItem = Nothing
            Set myDestFolderArquivados = Nothing
            Set myDestFolderDescartados = Nothing
            Set myRestrictItems = Nothing
            Set myItems = Nothing
            Set myInbox = Nothing
            Set myNamespace = Nothing
              
        myBase.MoveNext
        Loop
        
    myBase.Close
    Set myBase = Nothing
    dbBase.Close
    Set dbBase = Nothing
    
MsgBox "E-mails movidos com sucesso!", vbOKOnly, " • SAJ - Operação Concluída!"

End Function


observe se a versão do office é a mesma dos demais nesse computador

Sim, a empresa tem todas as máquinas com o mesmo office.

Nessa mesma máquina que nao está funcionando, funcionava perfeitamenta, ai eu toquei o arquivo e parou de funcionar, mas esse novo arquivo está certo, pois funciona nos outros PCs.

Tem um ponto que esqueci de mencionar, os usuários tem 2 contas de email cadastradas no outlook.

pode ser que sim.

estava dando uma lida no código, ele move alguns e-mail's e arquiva certo? não é melhor criar algumas regras nativas no outlook

Dependendo da categorizacao que o usuario colocam no sistema, ele move o email para algumas pastas...

Como faria a regra no email para ele saber qual foi a categoria que o usuario classificou aquele email no sistema?

a regra você cria uma vez só, conforme assunto, destinatário ou mesmo recebimento a ação acontece de maneira automática ao atualizar

=>Nois, obrigado por tentar ajudar, mas consegui identificar o que estava ocasionando o problema.

Quando o usuário tinha e-mails de resposta automática do outlook na pasta de inputs, o código era interrompido.

Como eu uso a propriedade SenderName para identificar qual e-mail deve ser movido, essa propriedade dá erro quando o e-mail é de resposta automática do próprio outlook.

Como e-mail de resposta automática não precisam de nenhuma tratativa pelos usuários, coloquei a regra neles apenas e está funcionando perfeitamente em todas as máquinas agora!

obrigado pelo retorno!