VBA Outlook - Operation Failed

Asked

Viewed 63 times

-1

I made a macro in Outlook 2016 that runs as soon as a new email arrives.

But sometimes the screen appears below at the time the email arrives:

Erro de falha na operação, mostrado pelo outlook 2016 ao tentar executar a macro

And if I ask the person to send a new email exactly like the one that caused the error or forward the same email or if I manually have the rule run for the messages in the inbox, the error does not appear again.

This is the only screen that error appears. No error appears in the lines of code during execution (because it does not even execute).

Below is the code used:

Public Sub enviarListaParceiras(Item As Outlook.MailItem)
    Dim strID As String
    Dim objMail As Outlook.MailItem
    Dim corpoEmail As String
    Dim assunto As String
    Dim de As String
    Dim mensagem As String
    Dim email As String
    Dim nomeEscola As String
    Dim idEscola As Long
    Dim excelApp As Excel.Application
    Dim obj_Connection As New ADODB.Connection
    Dim obj_RecordSet As New ADODB.Recordset
    Dim str_SQL As String
    Dim str_PlanilhaDestino As String
    Dim str_ConnString As String
    Dim str_LinhaInicial As String
    Dim nr_coluna As Integer
    Dim diaUltimaAtualizacao As String
    Dim horaUltimaAtualizacao As String
    Dim horaDoEmail As String
    Dim planilha As Workbook
    Dim nomeArquivo As String
    Dim nomeArquivo2 As String
    Dim dataArquivo As String
    Dim horaArquivo As String
    Dim horaParaPlanilha As String
    Dim dataParaPlanilha As String
    Dim saudacao As String
    Dim nomeEscolaAbreviado As String
    Dim nomeNovaPlanilha As String
    Dim FSO As FileSystemObject
    Dim nomeEnviado As String
    Dim atualizada As Boolean
    Dim grupo As Long
    Dim data, hora As String
    
    If Hour(Now) < 12 Then
        saudacao = "Bom dia!"
    ElseIf Hour(Now) > 11 And Hour(Now) < 18 Then
        saudacao = "Boa tarde!"
    ElseIf Hour(Now) > 17 Then
        saudacao = "Boa noite!"
    End If
    
    strID = Item.EntryID
    Set objMail = Application.Session.GetItemFromID(strID)
    corpoEmail = objMail.Body
    assunto = objMail.Subject
    grupo = CLng(Trim(Mid(assunto, InStr(1, assunto, ")") - 2, 2)))
    If InStr(1, assunto, "#atualizada") > 0 Or InStr(1, assunto, "#Atualizada") > 0 Then
        atualizada = True
    Else
        atualizada = False
    End If
    
    de = objMail.SenderEmailAddress
    If InStr(1, corpoEmail, "De:") <> 0 Then
        email = Mid(corpoEmail, InStr(1, corpoEmail, "De:") + 3, (InStr(1, corpoEmail, "Enviada em:") - 1) - (InStr(1, corpoEmail, "De:") + 3))
        If InStr(1, email, "<") <> 0 Then
            email = Mid(email, InStr(1, email, "<") + 1, ((InStr(1, email, ">") - 1) - InStr(1, email, "<")))
        End If
    End If
    horaDoEmail = objMail.ReceivedTime
    nomeEnviado = objMail.SenderName
    If email = "" Then
        email = de
    End If
    
    
    If atualizada = True Then
        Set excelApp = New Excel.Application
        excelApp.Visible = True
        Set planilha = excelApp.Workbooks.Open("[caminho da pasta]\tentativa 4.0.xlsm")
        With excelApp.Sheets("Principal")
            .Activate
            .Cells(3, "E") = "x"
            .Cells(5, "E") = "x"
        End With
        excelApp.DisplayAlerts = False
        excelApp.ScreenUpdating = False
        excelApp.Wait (Now + TimeValue("0:00:01"))
        On Error Resume Next
        excelApp.Run "'tentativa 4.0.xlsm'!principal"
        excelApp.Workbooks("tentativa 4.0.xlsm").Activate
        nomeNovaPlanilha = excelApp.Workbooks("tentativa 4.0.xlsm").Sheets("Principal").Cells(1, "M")
        excelApp.Workbooks("tentativa 4.0.xlsm").Save
        excelApp.Workbooks("tentativa 4.0.xlsm").Close
        excelApp.Quit
        nomeArquivo = ListaArquivos("[caminho da pasta]\Atual")
        Kill ("[caminho da pasta]\Atual\" & nomeArquivo)
        Set FSO = CreateObject("scripting.filesystemobject")
        Call FSO.CopyFile("[caminho da pasta]/" & nomeNovaPlanilha, "[caminho da pasta]/Atual/")
        nomeArquivo = ListaArquivos("[caminho da pasta]\Atual")
        data = Mid(nomeArquivo, 46, InStr(46, nomeArquivo, "_") - 46)
        hora = Mid(nomeArquivo, InStr(46, nomeArquivo, "_") + 1, InStr(1, nomeArquivo, ".") - InStr(46, nomeArquivo, "_"))
        hora = Left(hora, Len(hora) - 1)
        
        Set excelApp = New Excel.Application
        excelApp.DisplayAlerts = False
        excelApp.ScreenUpdating = False
        excelApp.Visible = True
        excelApp.Workbooks.Open ("[caminho da pasta]\Geração_ListaEspera_PARCEIRAS_2021_v2.6 - OUTLOOK.xlsm")
        excelApp.Wait (Now + TimeValue("0:00:01"))
        excelApp.Sheets("Seleção Escolas").Select
        DoEvents
        excelApp.Sheets("Seleção Escolas").Cells(grupo + 7, "A") = "x"
        excelApp.Sheets("Seleção Escolas").Cells(4, "A") = data
        excelApp.Sheets("Seleção Escolas").Cells(5, "A") = hora
        excelApp.Sheets("Seleção Escolas").Cells(1, "C") = nomeArquivo
        excelApp.Run ("chamarMetodos")
        excelApp.DisplayAlerts = False
        excelApp.ActiveWorkbook.Close
        
        texto = saudacao & "<br><br>Segue lista de espera da unidade parceira solicitada.<br><br>"
        nomeArquivo = ListaArquivos("[caminho da pasta]\enviar")
        
        Call encaminharEmailParceira(objMail, email, texto, "[caminho da pasta]\enviar\" & nomeArquivo)
        
        Kill ("[caminho da pasta]\enviar\" & nomeArquivo)
        
        excelApp.Quit
        Set objMail = Nothing
        Set excelApp = Nothing
        nomeEscola = ""
        idEscola = 0
        email = ""
    Else
        nomeArquivo = ListaArquivos("[caminho da pasta]\Atual")
        data = Mid(nomeArquivo, 46, InStr(46, nomeArquivo, "_") - 46)
        hora = Mid(nomeArquivo, InStr(46, nomeArquivo, "_") + 1, InStr(1, nomeArquivo, ".") - InStr(46, nomeArquivo, "_"))
        hora = Left(hora, Len(hora) - 1)
        
        Set excelApp = New Excel.Application
        excelApp.DisplayAlerts = False
        excelApp.ScreenUpdating = False
        excelApp.Visible = True
        excelApp.Workbooks.Open ("[caminho da pasta]\Geração_ListaEspera_PARCEIRAS_2021_v2.6 - OUTLOOK.xlsm")
        excelApp.Wait (Now + TimeValue("0:00:01"))
        excelApp.Sheets("Seleção Escolas").Select
        DoEvents
        excelApp.Sheets("Seleção Escolas").Cells(grupo + 7, "A") = "x"
        excelApp.Sheets("Seleção Escolas").Cells(4, "A") = data
        excelApp.Sheets("Seleção Escolas").Cells(5, "A") = hora
        excelApp.Sheets("Seleção Escolas").Cells(1, "C") = nomeArquivo
        excelApp.Run ("chamarMetodos")
        excelApp.DisplayAlerts = False
        excelApp.ActiveWorkbook.Close
        
        texto = saudacao & "<br><br>Segue lista de espera da unidade parceira solicitada.<br><br>"
        nomeArquivo = ListaArquivos("[caminho da pasta]\enviar")
        
        Call encaminharEmailParceira(objMail, email, texto, "[caminho da pasta]\enviar\" & nomeArquivo)
        
        Kill ("[caminho da pasta]\enviar\" & nomeArquivo)
        
        excelApp.Quit
        Set objMail = Nothing
        Set excelApp = Nothing
        nomeEscola = ""
        idEscola = 0
        email = ""
    End If
End Sub

The rule setting is in the following image: Configuração da regra no outlook 2016

I really have no idea what might be causing this mistake.

vba outlook

  • Damn it, voting negative without commenting on why doesn’t help me improve the question.

1 answer

0

Ricardo, blah, blah! I recommend that you always use a log to identify the error that is being generated, if unsolicited will not be informed, I will put below how you should do. 1st right after the start: Public Sub Sendersports(As Outlook Item.Mailitem) insert:

On Error Goto Err_Control

2º At the end of Sub or Functions, enter:

Err_Control:    
If Err.Number <> 0 Then
        MsgBox Err.Description
        Call LogErr("Insira_aqui_o_nome_que_quiser, identifica Sub or function", Err.Number, Err.Description)
    End If

Below the Function that writes in a txt file the errors where the code is executed, use it for Excel, not tested in Outlook, can be commented on so that it does not run, but at least the function Msgbox Err.Description, will inform error, and you can increment by displaying error number:

Msgbox "Description error:" & Err.Description & " Error number:" & Err.Number.

might help, just remove "Call Logerr" to not trigger the Log file.

Public Function LogErr(Modulo As String, ErrNumber As Long, ErrDescription As String)
On Error Resume Next
Dim strFile_Path As String
strFile_Path = Application.ActiveWorkbook.path & "\" & ActiveWorkbook.Name & "_" & "log_file.txt"
    Open strFile_Path For Append As #1
    Write #1, Now() & " | Módulo: " & Modulo & " | Err_Number: " & ErrNumber & " | Err_Description: " & ErrDescription & " | Máquina: " & Environ$("computername") & " | User: " & Application.UserName
    Close #1
End Function

To find out your "Application.ActiveWorkbook.path" locations use debug, in your case remove the continuation "Activeworkbook.Name" this very use for Excel, try to adapt to better identify what is causing your error, hope it helps. Try to test yourself by sending emails, do mass testing and then adapt to use as you wish.

  • Thank you very much for the suggestion, Julio. I will test for sure. When I have more information about the error, I will set the question.

  • Cool, enter the error number, it is not always possible to run debugging should be your case and it really becomes difficult to identify what causes "operation failure" which is the description of the error, in which operation? You can put in Err_control: stop and do F5 to see where this error is generated in the code.

  • I left only with the generation of the log file, without Msgbox and after several tests, unfortunately, when this error window appears, the log file is not generated.

  • Use msgbox then, to try to identify where the error is generated, as I commented above. Not all Outlook informs error, just quit while giving error, removes "On resume next error." Put a stop there on the error call, If err.number <>0 then stop, and see where the error is!

  • Test if the log file is generated by any other error, create any error and test to see if it works, where this file is generated, with me it always worked but Outlook is different yes, and I may be going over something that it does not do. I don’t know

  • The file is generated yes. Every time I forced an error while running, it generates. What seems, is that this error that appears the failure screen in the operation happens before executing the macro

  • Now that I’ve noticed the on error resume next in your code. Remove this so that it goes to the "on error goto Err_control:" then yes it i can record some error that before it tried to re-export, and when re-experiencing it clear the err.number, without this it may discover the error.

  • It seems to be a mistake to create excelApp and put "excelApp.Wait (Now + Timevalue("0:00:01")) On Error Resume Next" does not help, actually tries to override the error and then does not execute. Check this part of the code.

  • Puts, yeah. You’re right. The eye is so addicted, to review the code so much, I couldn’t even see the 'On error resume next'. I commented him.

Show 4 more comments

Browser other questions tagged vba outlook

You are not signed in. Login or sign up in order to post.