Reply (by .Send) e-mail Outlook “Run Script” rule not triggering VBA script for incoming messages

Question

(Since I'm from Brazil, there is some text in Portuguese, so if you need some help, just let me know).

I've got 2 macros in my Outlook "This Outlook Session" in 1 master macro that calls the others 2 that I mentioned before.

• The master macro do:
  Macro name: "Salvar_CNAB_Registro"

Discovers the subject of the e-mail and give the path I want depending what it's writing. After discover the path, save all the attachments from e-mail on the path discovered.

Sub Salvar_CNAB_Registro(Email As MailItem)     
    'Dim strSubject As String
    Dim objMsg As Outlook.MailItem
    Dim objSubject As String

    objSubject = Email.Subject

    'Defino qual caminho salvará os registros dos arquivos CNAB dependendo do produto da Funcesp ou da forma de liquidação
    If InStr(1, objSubject, "Registro de Boletos de Saúde - Vencimento") > 0 Then
       DiretorioAnexos = "S:\AFTData\OUTBOX\GE201658\"
       'DiretorioAnexos = "K:\Divisao_Administrativa_Financeira\Tesouraria\Contas_Receber\COBRANÇAS\SAÚDE\2019\03 MARÇO 2019\25.03.2019\TESTE\"
    ElseIf InStr(1, objSubject, "Registro de Boletos de Autopatrocínio - Vencimento") > 0 Then
       DiretorioAnexos = "S:\AFTData\OUTBOX\GE201658\"
    ElseIf InStr(1, objSubject, "Registro de Boletos de Seguros - Vencimento") > 0 Then
       DiretorioAnexos = "S:\AFTData\OUTBOX\GE201717\"
    ElseIf InStr(1, objSubject, "Registro de Débito Automático de Saúde - Vencimento") > 0 Then
       DiretorioAnexos = "S:\AFTData\OUTBOX\GE201775\"
    ElseIf InStr(1, objSubject, "Registro de Débito Automático de Autopatrocínio - Vencimento") > 0 Then
       DiretorioAnexos = "S:\AFTData\OUTBOX\GE201775\"
    ElseIf InStr(1, objSubject, "Registro de Débito Automático de Seguros - Vencimento") > 0 Then
       DiretorioAnexos = "S:\AFTData\OUTBOX\GE201775\"
    ElseIf InStr(1, objSubject, "Registro de Boletos de Empréstimo") > 0 Then
       DiretorioAnexos = "S:\AFTData\OUTBOX\GE201717\"
    End If

    Debug.Print "Diretório Macro Salvar_CNAB_Registro:"
    Debug.Print DiretorioAnexos

    Dim MailID As String
    Dim Mail As Outlook.MailItem

    MailID = Email.EntryID
    Set Mail = Application.Session.GetItemFromID(MailID)

    'Verifico se o anexo no e-mail é arquivo unixo TXT e salvo todos
    For Each Anexo In Mail.Attachments
        If Right(Anexo.FileName, 3) = "txt" Then
            Anexo.SaveAsFile DiretorioAnexos & "\" & Anexo.FileName
        End If
    Next

    'Verifico se o anexo no e-mail é arquivo unixo zip e salvo todos
    For Each Anexo In Mail.Attachments
        If Right(Anexo.FileName, 3) = "zip" Then
            Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            Call Unzipar_Arquivos
        End If

    Next

    DoEvents
    Call Reply_Email

    Set Mail = Nothing
 End Sub

• The first macro do:
  Macro name: Unzipar_Arquivos (calls the macro UnzipAFile)

It has two macros, it unzip any zip file attached in any e-mail called by the rule on Outlook.

Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)

Dim ShellApp As Object

'Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject("Shell.Application")
ShellApp.NameSpace(unzipToPath).CopyHere ShellApp.NameSpace(zippedFileFullName).Items

End Sub

Sub Unzipar_Arquivos()

Dim diretorio As Variant
Dim diretorio_ext As Variant
Dim nome_arquivo As String


'------------------------------------ Extraio os arquivos da pasta do Santander Outbox 1658 --------------------------------'


'Caminho que o arquivo será unzipado
diretorio_ext = "S:\AFTData\OUTBOX\GE201658\"

'Descobre o nome do arquivo zip + caminho que ele se encontra
nome_arquivo = Dir(diretorio_ext & "*.zip")

'Caminho que encontra-se o arquivo zipado
diretorio = "S:\AFTData\OUTBOX\GE201658\" & nome_arquivo

'Executo a macro enquanto houver arquivos zipados na pasta
Do While Len(nome_arquivo) > 0

    'A primeira parte refere-se ao nome do arquivo que será unzipado, e a segunda parte refere-se ao caminho que ele será unzipado
    Call UnzipAFile(diretorio, diretorio_ext)

    'Apago o primeiro arquivo zip que foi extraído
    'Primeiro remove o atributo de arquivo "somente leitura" caso esteja definido
    On Error Resume Next
    SetAttr FileToDelete, vbNormal
    'Depois apago o arquivo
    Kill diretorio

    'Procura o próximo arquivo
    nome_arquivo = Dir

    'Exibe mensagem de sucesso
    MsgBox "Arquivo " & nome_arquivo & "descompactado e arquivos registrados! " & "no diretório: " & diretorio_ext

Loop


'------------------------------------ Extraio os arquivos da pasta do Santander Outbox 1717 --------------------------------'


'Caminho que o arquivo será unzipado
diretorio_ext = "S:\AFTData\OUTBOX\GE201717\"

'Descobre o nome do arquivo zip + caminho que ele se encontra
nome_arquivo = Dir(diretorio_ext & "*.zip")

'Caminho que encontra-se o arquivo zipado
diretorio = "S:\AFTData\OUTBOX\GE201717\" & nome_arquivo

'Executo a macro enquanto houver arquivos zipados na pasta
Do While Len(nome_arquivo) > 0

    'A primeira parte refere-se ao nome do arquivo que será unzipado, e a segunda parte refere-se ao caminho que ele será unzipado
    Call UnzipAFile(diretorio, diretorio_ext)

    'Apago o primeiro arquivo zip que foi extraído
    'Primeiro remove o atributo de arquivo "somente leitura" caso esteja definido
    On Error Resume Next
    SetAttr FileToDelete, vbNormal
    'Depois apago o arquivo
    Kill diretorio

    'Procura o próximo arquivo
    nome_arquivo = Dir

    'Exibe mensagem de sucesso
    MsgBox "Arquivo " & nome_arquivo & "descompactado e arquivos registrados! " & "no diretório: " & diretorio_ext

Loop


'------------------------------------ Extraio os arquivos da pasta do Santander Outbox 1775 --------------------------------'


'Caminho que o arquivo será unzipado
diretorio_ext = "S:\AFTData\OUTBOX\GE201775\"

'Descobre o nome do arquivo zip + caminho que ele se encontra
nome_arquivo = Dir(diretorio_ext & "*.zip")

'Caminho que encontra-se o arquivo zipado
diretorio = "S:\AFTData\OUTBOX\GE201775\" & nome_arquivo

'Executo a macro enquanto houver arquivos zipados na pasta
Do While Len(nome_arquivo) > 0

    'A primeira parte refere-se ao nome do arquivo que será unzipado, e a segunda parte refere-se ao caminho que ele será unzipado
    Call UnzipAFile(diretorio, diretorio_ext)

    'Apago o primeiro arquivo zip que foi extraído
    'Primeiro remove o atributo de arquivo "somente leitura" caso esteja definido
    On Error Resume Next
    SetAttr FileToDelete, vbNormal
    'Depois apago o arquivo
    Kill diretorio

    'Procura o próximo arquivo
    nome_arquivo = Dir

    'Exibe mensagem de sucesso
    MsgBox "Arquivo " & nome_arquivo & "descompactado e arquivos registrados! " & "no diretório: " & diretorio_ext

Loop

End Sub

• The second macro do:
  Macro name: Reply_Email

Discover the name of each file that was saved before and then add the name on the body of the HTML e-mail that it's going to reply to all.

Sub Reply_Email()

    Dim strFolder As String
    Const strPattern As String = "*.txt"
    Dim strFile As String
    Dim nome_cnab As String
    Dim quantidade As Integer
    Dim add_msg As String
    Dim validador As Integer
    Dim i As Integer

    Debug.Print "Diretório Macro Responder_Email:"
    Debug.Print strFolder
    'Define o nome do caminho de acordo com o assunto (produto da funcesp que o cnab está sendo registrado) do e-mail enviado pelo funcionário solicitando o registro
    strFolder = DiretorioAnexos
    'Define a quantidade inicial de arquivos dentro da pasta que foi registrada
    quantidade = 0
    'Define o validador inicial igual a 0, isso significa que ainda não começou a montar o e-mail de resposta para a pessoa
    validador = 0
'Nome do passo quando ele montar o e-mail, e adicionará os nomes dos arquivos cnab através do loop
Add_Nome_Cnab:
    strFile = Dir(strFolder & strPattern, vbNormal)
    Do While Len(strFile) > 0
        'Caso queira ver o nome do arquivo CNAB na janela de verificação imediata (CTRL + G)
        'Debug.Print strFile
        strFile = Dir
        nome_cnab = strFile
        'Adiciono 1 na quantidade toda vez que passar por aqui, assim teremos a quantidade de arquivos salvos de cada e-mail
        quantidade = quantidade + 1
        'Se o validador for 1, ele grava o nome do arquivo na variavel
        If validador = 1 Then
            add_msg = nome_cnab
            'Vai para o passo de adicionar de fato o nome do arquivo no corpo do e-mail através da variavel criada acima
            GoTo Check_Validador
        End If
    Loop

    Dim olItem As Outlook.MailItem
    Dim olReply As MailItem ' Reply

    For Each olItem In Application.ActiveExplorer.Selection
        Set olReply = olItem.ReplyAll
        'Define o validador como 1, para começar a montar o e-mail
        validador = 1
        'Se tiver 1 arquivo ou mais, ele começa a montar o e-mail
        If quantidade > 0 Then
            For i = 1 To quantidade
                'Vai para o passo de gravar o nome do arquivo na variavel
                GoTo Add_Nome_Cnab
Check_Validador:
                'Essa etapa que ele adiciona de fato o nome no corpo do e-mail através da variavel criada acima
                olReply.HTMLBody = "<br>" & add_msg & vbCrLf & olReply.HTMLBody
                DoEvents
            Next i
        Else
            olReply.HTMLBody = "<br>" & "Nenhum arquivo CNAB registrado" & "<br>" & vbCrLf & olReply.HTMLBody
        End If
            'Escreve as duas primeiras linhas no corpo do e-mail: "Arquivos registrados no dia e hora: " + Data e Hora + "Segue arquivos registrados: "
            olReply.HTMLBody = "<br>" & "Arquivos registrados no dia e hora: " & Now & "<br>" & "Segue arquivos registrados: " & "<br>" & vbCrLf & olReply.HTMLBody
            DoEvents
            'Mostra o e-mail na tela
            olReply.Display
            DoEvents
            'Envia o e-mail
            olReply.Send
            DoEvents
    Next olItem
End Sub

All the macros works as a charm individually, but my problem is when the master macro "Salvar_CNAB_Registro" calls the last macro (Reply_Email) and the e-mail doesn't send by itself automatically.

So, if I run the script alone, it works!!! But, it doesn't work called by another macro.

EDIT 1:

I did some tests, but still can't work unless I debug.

What I did:

Added the macro to test all the macros together, each one calling each other.

Sub Test() Dim x, mailItem As Outlook.mailItem For Each x In Application.ActiveExplorer.Selection If TypeName(x) = "MailItem" Then Set mailItem = x Call Salvar_CNAB_Registro(mailItem) End If Next End Sub

So, still works sending the e-mail by debugging but it doesn't work by calling from the rule. I mean, all the macro works, but only don't display and send the e-mail.

I tried the solution from @0m3r, removing the line Application.ActiveExplorer.Selection from the macro Reply_Email, using Sub Reply_Email(ByVal Email As Object) and then calling it like Reply_Email(Email), but this method don't work.

I tried even using Sub Reply_Email(Email As Outlook.mailItem) and then calling it like Reply_Email(Email), this method worked by debugging again, but not automatically.

I also tried this method (How to Auto Reply with Outlook rule), by replying the e-mail from the rule directly but the original message in the body was not there, also I can't sign this code in my work.

Answer 1

It worked! I followed @0m3r tips, and also I did some research on web to try to fix this issue.

What I did:

Now, my macro is Sub Reply_Email(ByVal Email As Object) I named only Dim olReply As mailItem and Set olReply = Email.ReplyAll.

And the main difference that I saw was this part:

With olReply
    'Envia o e-mail
    .Send
End With

So after added this, the e-mail was send. The macro is called by Call Reply_Email(Email).

And finally, I added a rule that will not reply the e-mail if there is the word "ENC:" or "RES:" in the subject, it means that if there is some reply e-mail in the inbox, it will do nothing.