locked
Macro/Script to forward emails dragged into a Outlook subfolder to move it to new folder RRS feed

  • Question

  • Can you help me with the Outlook macro/script on this process?

    I have 3 sub folders under inbox, A_Type Email folder, B_Type Email folder and Forwarded Emails folder

    Whenever I drag emails to either A_Type Email folder or B_Type Email folder, the email will automatically forwarded to a specific emails address and after that it will move to Forwarded Emails folder automatically?

    Thank you for your assistance! I really appreciate it.

    Thursday, April 9, 2015 5:35 PM

All replies

  • Put the following code in the ThisOutlookSession module. Check the folder names, recipient details and message texts are correct, then before closing the editor, run the Macro 'Application_StartUp'.

    Then when you move item(s) to either 'A_Type Email' or 'B_Type Email', the message will be forwarded to the named recipient with the covering message, then moved to the third named folder.


    Option Explicit
    Private WithEvents MoveItems_A As Outlook.Items
    Private WithEvents MoveItems_B As Outlook.Items
    
    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
        Set olApp = Outlook.Application
        Set olNS = olApp.GetNamespace("MAPI")
        Set MoveItems_A = olNS.GetDefaultFolder(olFolderInbox).folders("A_Type Email").Items
        Set MoveItems_B = olNS.GetDefaultFolder(olFolderInbox).folders("B_Type Email").Items
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub MoveItems_A_ItemAdd(ByVal item As Object)
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    Dim oMail As Outlook.MailItem
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
        Set olApp = Outlook.Application
        Set olNS = olApp.GetNamespace("MAPI")
        'On Error GoTo ErrorHandler
        If item.Class = olMail Then
            Set oMail = item.Forward
            With oMail
                .To = "someone@somewhere.com"        'The recipient of the forwarded message
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "The accompanying message text"
                .Display
                .sEnd        'Restore after testing
            End With
            MoveToFolder item, _
                         olNS.GetDefaultFolder(olFolderInbox).folders("A_Type Email"), _
                         olNS.GetDefaultFolder(olFolderInbox).folders("Forwarded Emails")
        End If
    lbl_Exit:
        Set oMail = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number & " - " & Err.Description
        GoTo lbl_Exit
    End Sub
    
    Private Sub MoveItems_B_ItemAdd(ByVal item As Object)
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    Dim oMail As Outlook.MailItem
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
        Set olApp = Outlook.Application
        Set olNS = olApp.GetNamespace("MAPI")
        'On Error GoTo ErrorHandler
        If item.Class = olMail Then
            Set oMail = item.Forward
            With oMail
                .To = "someoneelse@somewhere.com"        'The recipient of the forwarded message
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "The accompanying message text"
                .Display
                .sEnd        'Restore after testing
            End With
            MoveToFolder item, _
                         olNS.GetDefaultFolder(olFolderInbox).folders("B_Type Email"), _
                         olNS.GetDefaultFolder(olFolderInbox).folders("Forwarded Emails")
        End If
    lbl_Exit:
        Set oMail = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number & " - " & Err.Description
        GoTo lbl_Exit
    End Sub
    
    Sub MoveToFolder(olItem As Object, Source As Folder, Target As Folder)
    Dim olNS As Outlook.NameSpace
    Dim olMsg As Outlook.MailItem
    Dim i As Long
        On Error Resume Next
        Set olNS = Application.GetNamespace("MAPI")
        Set Target = olNS.GetDefaultFolder(olFolderInbox).folders(Target)
        If olItem.DefaultItemType = olMailItem Then
            olItem.Move Target
        End If
        Source.Items(1).Delete
        Set olNS = Nothing
    lbl_Exit:
        Exit Sub
    End Sub
    
    



    Graham Mayor - Word MVP
    www.gmayor.com

    Sunday, April 12, 2015 11:35 AM
  • Hi Graham,

    Thanks for your input and help! I'll let you know once I test it in my end tomorrow.

    Also, one more thing, how to send using different Outlook/Exchange email address in FROM/Sender field when I dragged the email and script/macro will change the FROM/Sender before forward it?

    Sunday, April 12, 2015 8:01 PM
  • I think you will find that the following should change the sending account

    Add the following declarations (using the correct account information)

    Dim oAccount As Outlook.Account
    Const strAcc As String = "Account Display Name"

    then change the code as follows:

    For Each oAccount In olNS.Accounts
        If oAccount.DisplayName = strAcc Then
            Set oMail = Item.Forward
            With oMail
                .SendUsingAccount = oAccount
                .To = "someoneelse@somewhere.com" 
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "The accompanying message text"
                .Display
                .sEnd        'Restore after testing
            End With
            Exit For
        End If
    Next oAccount



    Graham Mayor - Word MVP
    www.gmayor.com



    Monday, April 13, 2015 6:05 AM
  • Hi, Sorry to bother you about this.

    But what specific codes should I replace with these codes:

    For Each oAccount In olNS.Accounts
        If oAccount.DisplayName = strAcc Then
            Set oMail = Item.Forward
            With oMail
                .SendUsingAccount = oAccount
                .To = "someoneelse@somewhere.com" 
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "The accompanying message text"
                .Display
                .sEnd        'Restore after testing
            End With
            Exit For
        End If
    Next oAccount

    I'm having error whenever I try to replace the codes.

    Thank you!

    Monday, April 13, 2015 11:58 AM
  • In the original macro replace

           Set oMail = item.Forward
            With oMail
                .To = "someoneelse@somewhere.com"        'The recipient of the forwarded message
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "The accompanying message text"
                .Display
                '.sEnd        'Restore after testing
            End With

    I don't have an Exchange Account access here so to test it.

    If that doesn't work use instead

          Set oMail = item.Forward
            With oMail
                .To = "someoneelse@somewhere.com" 
                .BodyFormat = olFormatHTML
                .SentOnBehalfOfName = "account name"
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "The accompanying message text"
                .Display
                '.sEnd        'Restore after testing
            End With

    Did you change the account name from "Account Display Name" to what you have?

    What's the error?


    Graham Mayor - Word MVP
    www.gmayor.com





    Monday, April 13, 2015 12:03 PM
  • Yes, I have changed the "Account Display Name".

    Also, I did replace the codes and nothing happens, it is not sending at all, it just move the emails to the Forwarded Email folders.

    Is it okay if you paste the whole codes with SendUsingAccount on it? The 1st code is working fine. And thanks a lot about that. I really appreciate it.

    Thanks!

    Monday, April 13, 2015 12:19 PM
  • Hi, Actually I was able to use the Send on Behalf code but whenever it is sent to another mail, it still uses the default account not the specific account I entered.


    Monday, April 13, 2015 12:36 PM
  • As I said, I don't have access to Exchange Server here, but I seem to recall that Send on Behalf is required with Exchange accounts, whereas the change account code works with POP accounts. I am pretty sure that the recipient will see only the account you sent on behalf of.

    Graham Mayor - Word MVP
    www.gmayor.com

    Monday, April 13, 2015 1:55 PM
  • It's okay, sorry to bother you.

    Actually, I'm using exchange accounts with this. It seems that its not sending with the specific email address I set, still using the default email.

    Already gave, Send As permissions, Send on Behalf and Full permissions but still the FROM field shows the specific address but when I clicked it, it shows the details of default account. Just don't know what is wrong. I know that there is nothing wrong with the codes, I just don't know where the issue is coming from.

    Btw, how about a rule that the dragged emails will only move if its successfully send? Cause I tried Displaying it without sending it still moves to the Forwarded emails.

    Monday, April 13, 2015 5:52 PM
  • Hi this script is working fine and good!

    My only problem is there are times that emails are being forwarded twice. Meaning to say there are two emails that are being sent to that specific address.

    Please advise.

    Tuesday, June 16, 2015 12:33 PM