Styjun

(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:AFTDataOUTBOXGE201658"
 'DiretorioAnexos = "K:Divisao_Administrativa_FinanceiraTesourariaContas_ReceberCOBRANÇASSAÚDE20193 MARÇO 201925.03.2019TESTE"
 ElseIf InStr(1, objSubject, "Registro de Boletos de Autopatrocínio - Vencimento") > 0 Then
 DiretorioAnexos = "S:AFTDataOUTBOXGE201658"
 ElseIf InStr(1, objSubject, "Registro de Boletos de Seguros - Vencimento") > 0 Then
 DiretorioAnexos = "S:AFTDataOUTBOXGE201717"
 ElseIf InStr(1, objSubject, "Registro de Débito Automático de Saúde - Vencimento") > 0 Then
 DiretorioAnexos = "S:AFTDataOUTBOXGE201775"
 ElseIf InStr(1, objSubject, "Registro de Débito Automático de Autopatrocínio - Vencimento") > 0 Then
 DiretorioAnexos = "S:AFTDataOUTBOXGE201775"
 ElseIf InStr(1, objSubject, "Registro de Débito Automático de Seguros - Vencimento") > 0 Then
 DiretorioAnexos = "S:AFTDataOUTBOXGE201775"
 ElseIf InStr(1, objSubject, "Registro de Boletos de Empréstimo") > 0 Then
 DiretorioAnexos = "S:AFTDataOUTBOXGE201717"
 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:AFTDataOUTBOXGE201658"

'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:AFTDataOUTBOXGE201658" & 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:AFTDataOUTBOXGE201717"

'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:AFTDataOUTBOXGE201717" & 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:AFTDataOUTBOXGE201775"

'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:AFTDataOUTBOXGE201775" & 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.

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.