none
Adapting VBA Code to Automatically Forward Emails RRS feed

  • Question

  • I need to adapt the code that is already used, to forward the email with the attachments.for two people if there is attached a .pdf file

    here is my code

    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
                'FORWARD TO "A@A.COM" & "B@B.com"
            'End If
            
            End If
        Next
        
        Set Mail = Nothing
    End Sub

    • Moved by Steve Fan Wednesday, June 6, 2018 2:20 AM VBA related
    Tuesday, June 5, 2018 6:54 PM

Answers

  • Hello Gabriel Alves Ferreira,

    You could try some code like this.

    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" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            ElseIf Right(Anexo.FileName, 3) = "pdf" Then
                forwardFlag = 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 forwardFlag Then
            Set ForWardMail = Mail.Forward
            With ForWardMail
            .Recipients.Add "A@A.COM"
            .Recipients.Add "B@B.com"
            .Display
            'send with send the mail directly
            'send
            End With
        End If
        
        Set Mail = Nothing
    End Sub

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, June 6, 2018 6:45 AM
  • Hello,

    For sharing file, you could share it via cloud storage, such as One Drive, and then put the link address here.

    I would suggest you msgbox to check Right(Anexo.FileName, 3) value and in case that there is any lower case or up case issue, I would suggest you lower case the Right(Anexo.FileName, 3) for comparing with "pdf".

    Code looks like

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

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, June 7, 2018 1:41 AM

All replies

  • I do not know what code I need to use
    Tuesday, June 5, 2018 7:06 PM
  • Hi,

    Welcome to the Microsoft Office for IT Professionals Outlook forum. This forum is for non-programming questions related to Microsoft Outlook. Since your question is more related to VBA, I'll move it to the following dedicated forum:

    https://social.msdn.microsoft.com/Forums/office/en-US/home?forum=outlookdev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding. 

    Regards,
    Steve Fan


    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact tnsf@microsoft.com.


    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Teams.

    Wednesday, June 6, 2018 2:19 AM
  • Hello Gabriel Alves Ferreira,

    You could try some code like this.

    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" Then
                Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
            ElseIf Right(Anexo.FileName, 3) = "pdf" Then
                forwardFlag = 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 forwardFlag Then
            Set ForWardMail = Mail.Forward
            With ForWardMail
            .Recipients.Add "A@A.COM"
            .Recipients.Add "B@B.com"
            .Display
            'send with send the mail directly
            'send
            End With
        End If
        
        Set Mail = Nothing
    End Sub

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, June 6, 2018 6:45 AM
  • does't worked, I'm about to give up D:
    Wednesday, June 6, 2018 4:31 PM
  • does't worked, I'm about to give up D:

    What do you mean?

    In my Outlook 2013 the sample macro created a new message displayed in an Inspector Window containing the A@A.COM and B@B.COM addresses in the To field.

    Wednesday, June 6, 2018 6:35 PM
  • I put some msgbox in the code with some numbers and I received an email with pdf, and only displayed the numbers 1, 4 and 7

    OUTLOOK 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 "gabriel.alvesferreira@gmail.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



    Wednesday, June 6, 2018 7:08 PM
  • Are you sure you are running the macro on a mail message that has pdf attachments?
    Wednesday, June 6, 2018 7:16 PM
  • Yes, I tried attaching a print screen here, but it did not work.

    Wednesday, June 6, 2018 7:27 PM
  • Hello,

    For sharing file, you could share it via cloud storage, such as One Drive, and then put the link address here.

    I would suggest you msgbox to check Right(Anexo.FileName, 3) value and in case that there is any lower case or up case issue, I would suggest you lower case the Right(Anexo.FileName, 3) for comparing with "pdf".

    Code looks like

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

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, June 7, 2018 1:41 AM
  • This msgbox did not appear that you inserted in this code. It does not execute the conditions (FOR and IF), everything that is out of conditions runs normally. Will it be a problem with my Office 2010?
    Thursday, June 7, 2018 10:53 AM
  • I found the error.

    the user's computer was configured with IMAP, and I have not thought of checking this before.

    Last doubt. I solved the problem in saving xml and forward if there is pdf, I would like to move that email to a folder called "archived"

    how do I do that?
    Thursday, June 7, 2018 6:12 PM