none
Preciso adaptar um código já existente para Encaminhar emails automaticamente RRS feed

  • Pergunta

  • Eu preciso adaptar o código que já é utilizado, para encaminhar o e-mail com os anexos para duas pessoas caso haja em anexo um arquivo .pdf 

    segue o código

    Public Sub ProcessarAnexo(Email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
            
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            'If Right(Anexo.FileName, 3) = "pdf" Then
                'ENVIAR PARA "A@A.COM" & "B@B.COM"
            'End If
            
            End If
        Next
        
        Set Mail = Nothing
    End Sub

    terça-feira, 5 de junho de 2018 18:57

Respostas

  • Acho que agora vai.

    Public Sub ProcessarAnexo(email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
     
        flagXML = False
        flagPDF = False
        
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                flagXML = True
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            ElseIf Right(Anexo.FileName, 3) = "pdf" Then
                flagPDF = True
            End If
        Next
        
        'in case that there are multiple pdf attachemnts in the mail
        'use a flag to mark to forward the mails istead of forwarding the mail directly
        Dim ForWardMail As Outlook.MailItem
        If (flagXML And flagPDF) Then
            Set ForWardMail = Mail.Forward
            With ForWardMail
            .Recipients.Add "gabriel@gabriel"
            .Recipients.Add "francisco@francisco"
            .Display
            'send with send the mail directly
            '
            '.Send
            End With
        End If
        
        Set Mail = Nothing
    End Sub


    https://inframicrosoft.wordpress.com/

    quinta-feira, 7 de junho de 2018 13:17

Todas as Respostas

  • Olá.

    E em qual parte do script está enfrentando dificuldade?


    https://inframicrosoft.wordpress.com/

    terça-feira, 5 de junho de 2018 19:02
  • Não sei que código inserir pra ele encaminhar os e-mails com os anexos quando o e-mail que chegar e tiver em anexo um .pdf

    Tenho muito pouca experiência com Vba

    terça-feira, 5 de junho de 2018 19:05
  • Como e quando o script deverá ser acionado?

    https://inframicrosoft.wordpress.com/

    terça-feira, 5 de junho de 2018 19:42
  • No script atual, ele verifica o e-mail que chega na caixa de entrada e salva tiver um anexo de formato .XML.

    Gostaria de além de verificar e baixar caso houver um arquivo .xml, se também houver um arquivo .pdf encaminhar esse e-mail com os anexos para duas pessoas.


    terça-feira, 5 de junho de 2018 19:51
  • Isso funciona como uma regra do próprio Outlook?

    https://inframicrosoft.wordpress.com/

    terça-feira, 5 de junho de 2018 19:52
  • sim, a regra chama o script
    terça-feira, 5 de junho de 2018 19:52
  • Ok.

    Veja:

    Link 1

    Link 2

    Tente elaborar seu script com base nisso e se tiver alguma dúvida é só replicar.


    https://inframicrosoft.wordpress.com/

    terça-feira, 5 de junho de 2018 19:58
  • recebi esse script aqui, mas também não funcionou.

    Public Sub ProcessarAnexo(email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
        forwardFlag = False
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" & Right(Anexo.FileName, 3) = "pdf" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName & forwardFlag = True
                
            ElseIf Right(Anexo.FileName, 3) = "xml" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            End If
        Next
        'in case that there are multiple pdf attachemnts in the mail
        'use a flag to mark to forward the mails istead of forwarding the mail directly
        Dim ForWardMail As Outlook.MailItem
        If forwardFlag Then
            Set ForWardMail = Mail.Forward
            With ForWardMail
            .Recipients.Add "gabriel@gabriel"
            .Recipients.Add "francisco@francisco"
            .Display
            'send with send the mail directly
            'send
            End With
        End If
        
        Set Mail = Nothing
    End Sub


    quarta-feira, 6 de junho de 2018 16:32
  • Recapitulando:

    Se houver um ou mais xml como anexo, salvar na pasta.

    Se houver um ou mais pdf, independente de outros anexos, enviar a mensagem.

    Está correto o raciocínio acima?


    https://inframicrosoft.wordpress.com/

    quarta-feira, 6 de junho de 2018 17:28
  • For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" & Right(Anexo.FileName, 3) = "pdf" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName & forwardFlag = True
                
            ElseIf Right(Anexo.FileName, 3) = "xml" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            End If

    Se houver um ou mais xml e pdf, salvar xml e encaminhar e-mail

    Se houver um ou mais xml, apenas salvar

    A intenção desse script é salvar o xml em um diretório base de um software de gestão. Porém, se houver .pdf, isso quer dizer que esse pdf é uma nota fiscal que deve ser direcionada para o e-mail do financeiro.

    quarta-feira, 6 de junho de 2018 17:40
  • Olá.

    Pensei assim:

      forwardFlag = False
        flagXML = False
        
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
                flagXML = True
            ElseIf Right(Anexo.FileName, 3) = "pdf" Then
                forwardFlag = flagXML
            End If
        Next

    Acrescentei uma flag para saber se tem xml.


    https://inframicrosoft.wordpress.com/

    quarta-feira, 6 de junho de 2018 18:53
  • Ainda não funciona, acredito que estou com algum problema no office. Inseri 7 MSGBOX  pelo código, e ao receber um e-mail só com pdf, ou só com xml ou com os dois arquivos, só me retornou o numero 1, 4 e 7

    Segue o codigo:

    Office 2010

    Public Sub ProcessarAnexo(email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
        forwardFlag = False
        MsgBox "1"
        For Each anexo In Mail.Attachments
            If Right(anexo.FileName, 3) = "xml" Then
                anexo.SaveAsFile DiretorioAnexos & anexo.FileName
                MsgBox "2"
            ElseIf Right(anexo.FileName, 3) = "pdf" Then
                forwardFlag = True
                MsgBox "3"
            End If
        Next
        'in case that there are multiple pdf attachemnts in the mail
        'use a flag to mark to forward the mails istead of forwarding the mail directly
        Dim ForWardMail As Outlook.MailItem
        MsgBox "4"
        If forwardFlag Then
            Set ForWardMail = Mail.Forward
            MsgBox "5"
            With ForWardMail
            .Recipients.Add "a@a.com"
            .Recipients.Add "B@B.com"
            .Display
            'send with send the mail directly
            .Send
            MsgBox "6"
            End With
            
        End If
        
        Set Mail = Nothing
        MsgBox "7"
    End Sub


    quarta-feira, 6 de junho de 2018 19:50
  • Acho que agora vai.

    Public Sub ProcessarAnexo(email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
     
        flagXML = False
        flagPDF = False
        
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                flagXML = True
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            ElseIf Right(Anexo.FileName, 3) = "pdf" Then
                flagPDF = True
            End If
        Next
        
        'in case that there are multiple pdf attachemnts in the mail
        'use a flag to mark to forward the mails istead of forwarding the mail directly
        Dim ForWardMail As Outlook.MailItem
        If (flagXML And flagPDF) Then
            Set ForWardMail = Mail.Forward
            With ForWardMail
            .Recipients.Add "gabriel@gabriel"
            .Recipients.Add "francisco@francisco"
            .Display
            'send with send the mail directly
            '
            '.Send
            End With
        End If
        
        Set Mail = Nothing
    End Sub


    https://inframicrosoft.wordpress.com/

    quinta-feira, 7 de junho de 2018 13:17
  • Amigos, eu to quase desistindo. 

    Em todos os códigos que vão me passando e não funcionam eu coloco msgbox pra ver se ele chega a entrar no for ou no if, porém, nenhuma msg box que é inserida dentro do for ou if aparece, toda msgbox que esta fora do for e do if aparece normalmente quando chega um e-mail.

    Pode ser um problema de configuração?

    quinta-feira, 7 de junho de 2018 14:04
  • Aqui nos meus testes funcionou.

    https://inframicrosoft.wordpress.com/

    quinta-feira, 7 de junho de 2018 14:45
  • Encontrei o erro.

    O e-mail onde era testado estava configurado como IMAP e só funciona com POP.

    ultima dúvida, eu gostaria que após enviar o e-mail ele muda-se a pasta. Da caixa de entrada para uma pasta chamada "Arquivado"

    quinta-feira, 7 de junho de 2018 18:02
  • Veja o link 1 enviado anteriormente, lá tem um exemplo de como mover para outra pasta.


    https://inframicrosoft.wordpress.com/


    • Editado J. Maurício quinta-feira, 7 de junho de 2018 18:09
    quinta-feira, 7 de junho de 2018 18:08
  • Inseri esse código porém não funcionou.

    '...    

    'end if

    Dim SubFolder As Outlook.MAPIFolder Dim ns As Outlook.NameSpace Set ns = Application.GetNamespace("MAPI") Set SubFolder = ns.Folders("Arquivado") Mail.Move SubFolder Set SubFolder = Nothing Set Mail = Nothing End Sub


    sexta-feira, 8 de junho de 2018 12:37
  • Olá.

    Desculpe-me. A sugestão sobre o link não ajudava. Foi um equívoco.

    Apenas tente colocar a linha abaixo depois de ter encaminhado o e-mail (e dentro do if):

    Mail.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Arquivado"))

    No meu teste funcionou.


    https://inframicrosoft.wordpress.com/


    • Editado J. Maurício sexta-feira, 8 de junho de 2018 14:16
    sexta-feira, 8 de junho de 2018 14:15
  • Opa Mauricio, confirma se ta tudo ok.

    Rodei aqui, porém não arquivou.

    Public Sub ProcessarAnexo(email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "C:\Users\gabriel\Documents\xmlepdf\"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
         
        MailID = email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
     
        flagXML = False
        flagPDF = False
       
        For Each anexo In Mail.Attachments
        
            If Right(anexo.FileName, 3) = "xml" Or Right(anexo.FileName, 3) = "XML" Then
                flagXML = True
                anexo.SaveAsFile DiretorioAnexos & anexo.FileName
            End If
            
            If Right(anexo.FileName, 3) = "pdf" Or Right(anexo.FileName, 3) = "PDF" Then
                flagPDF = True
            End If
            
        Next
        
        'in case that there are multiple pdf attachemnts in the mail
        'use a flag to mark to forward the mails istead of forwarding the mail directly
        Dim ForWardMail As Outlook.MailItem
        If (flagXML And flagPDF) Then
            Set ForWardMail = Mail.Forward
            With ForWardMail
            .Recipients.Add "a@a"
            .Recipients.Add "b@b"
            .Display
            'send with send the mail directly
            '
            .Send
            End With
        Mail.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Arquivado"))
        
        End If
    
        
        Set Mail = Nothing
    End Sub
    


    sexta-feira, 8 de junho de 2018 14:27
  • Olha o meu código:

    Public Sub ProcessarAnexo(email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = "O:\GestaoXML\XMLRECEBIDO\"
    
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        
        MailID = email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)
     
        flagXML = False
        flagPDF = False
        
        For Each Anexo In Mail.Attachments
            If Right(Anexo.FileName, 3) = "xml" Then
                flagXML = True
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            ElseIf Right(Anexo.FileName, 3) = "pdf" Then
                flagPDF = True
            End If
        Next
        
        'in case that there are multiple pdf attachemnts in the mail
        'use a flag to mark to forward the mails istead of forwarding the mail directly
        Dim ForWardMail As Outlook.MailItem
        If (flagXML And flagPDF) Then
            Set ForWardMail = Mail.Forward
            With ForWardMail
                .Recipients.Add "gabriel@gabriel"
                .Recipients.Add "francisco@francisco"
                .Display
                'send with send the mail directly
                '
                '.Send
            End With
            Mail.Move (Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Pasta"))
        End If
        
        Set Mail = Nothing
    End Sub
    

    Não achei diferença. Sua pasta arquivado está dentro da imbox?


    https://inframicrosoft.wordpress.com/

    sexta-feira, 8 de junho de 2018 14:41
  • 
    sexta-feira, 8 de junho de 2018 14:47
  • Faz um teste. Tenta criar uma pasta dentro de Caixa de Entrada e tenta mover para essa nova pasta.

    https://inframicrosoft.wordpress.com/


    • Editado J. Maurício sexta-feira, 8 de junho de 2018 14:56
    sexta-feira, 8 de junho de 2018 14:55
  • Nada ainda

    sexta-feira, 8 de junho de 2018 15:02
  • Eu utilizo Exchange aqui. Não sei se pode ser algo de configuração. Não sei o que pode estar ocorrendo. Você tentou mover sem enviar?

    https://inframicrosoft.wordpress.com/


    • Editado J. Maurício sexta-feira, 8 de junho de 2018 15:15
    sexta-feira, 8 de junho de 2018 15:13
  • Não tem nada haver por ter um comando "getdefaultfolder"?

    acredito que essa pasta não seja padrão!

    sexta-feira, 8 de junho de 2018 16:28