1. 技术文章
  2. Reply (by .Send) e-mail Outlook “Run Script” rule not triggering VBA script for incoming messages

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

由 别说谁变了你拦得住时间么 提交于 2019-12-11 05:15:39

问题


(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.


回答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.



来源：https://stackoverflow.com/questions/55364251/reply-by-send-e-mail-outlook-run-script-rule-not-triggering-vba-script-for

标签
vba
outlook
outlook-vba
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!