Ответ (по .Send) по электронной почте Правило «Выполнить сценарий» в Outlook не запускает сценарий VBA для входящих сообщений. - PullRequest
Новая
       14

Ответ (по .Send) по электронной почте Правило «Выполнить сценарий» в Outlook не запускает сценарий VBA для входящих сообщений.

1 голос
/ 26 марта 2019

(Поскольку я из Бразилии, на португальском языке есть текст, поэтому, если вам нужна помощь, просто дайте мне знать).

У меня есть 2 макроса в Outlook "Эта сессия Outlook"в 1 главном макросе, который вызывает другие 2, о которых я упоминал ранее.

  • Основной макрос выполняет:
    Имя макроса: "Salvar_CNAB_Registro"

Обнаруживает темуэлектронной почты и укажите путь, который я хочу, в зависимости от того, что он пишет.После обнаружения пути сохраните все вложения из электронной почты на обнаруженном пути. 

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
  • Первый макрос делает:
    Имя макроса: Unzipar_Arquivos (вызывает макрос UnzipAFile)

У него есть два макроса, он распаковывает любой zip-файл, прикрепленный к любому электронному письму, вызываемому правилом в 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
  • Второй макрос выполняет:
    Имя макроса: Reply_Email

Найдите имя каждого файла, который был сохранен ранее, а затем добавьте имя в тексте электронного письма в формате HTML, которое оно будет отвечать всем.

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

Все макросы работают отдельно, но моя проблема в том, что главный макрос "Salvar_CNAB_Registro" вызывает последний макрос (Reply_Email) и электронное письмо не отправляется само по себе.

Итак, если я запускаю скрипт один, он работает !!!Но он не работает, вызывается другим макросом.

РЕДАКТИРОВАТЬ 1:

Я провел несколько тестов, но все равно не могу работать, если не отлаживаю.

Что я сделал:

Добавлен макрос для проверки всех макросов вместе, каждый из которых вызывает друг друга.

Sub Test () Dim x, mailItem As Outlook.mailItem For Eachx В Application.ActiveExplorer.Selection If TypeName (x) = "MailItem" Затем установите mailItem = x Вызовите Salvar_CNAB_Registro (mailItem) End If Next End Sub

Итак, все еще работает отправка электронной почты путем отладки, ноне работает, звоня из правила.Я имею в виду, что все макросы работают, но только не отображают и не отправляют электронную почту.

Я пробовал решение из @ 0m3r, удаляя строку Application.ActiveExplorer.Selection из макроса Reply_Email, используя Sub Reply_Email(ByVal Email As Object), а затем вызывать его как Reply_Email(Email), но этот метод не работает.

Я пытался даже использовать Sub Reply_Email(Email As Outlook.mailItem), а затем вызывать его как Reply_Email(Email), этот метод работал путем отладки снова, но неавтоматически.

Я также попробовал этот метод ( Как выполнить автоматический ответ с правилом Outlook ), напрямую ответив на электронное письмо из правила, но исходного сообщения в теле не было,также я не могу подписать этот код в моей работе.

1 Ответ

1 голос
/ 05 апреля 2019

Это сработало!Я следовал советам @ 0m3r, а также провел некоторые исследования в Интернете, чтобы попытаться решить эту проблему.

Что я сделал:

Теперь мой макрос Sub Reply_Email(ByVal Email As Object) Я назвал только Dim olReply As mailItem и Set olReply = Email.ReplyAll.

И основным отличием, которое я увидел, была эта часть: 

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

Итак, после добавления этого, электронное письмо было отправлено.Макрос вызывается Call Reply_Email(Email).

И, наконец, я добавил правило, которое не будет отвечать на электронные письма, если в теме есть слово "ENC:" или "RES:", это означает, что еслив почтовом ящике есть ответное письмо, оно ничего не даст.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...