Outlook send selected email as attachment and delete

Posted on 2011-04-28
Last Modified: 2012-05-11
I'm looking for a way to automaticaly send email items in my inbox as an attachment to a fixed address. Also I 'd like to creat a button on my toolbar and tie this action to it.

Example: I select a few items in my inbox and then click the toolbar button. Those selected items are then inserted in to a new email. That new email is sent to a After the email is sent, the selected emails are deleted.

I'm using Outlook 2010
Question by:Erik Curtis
    LVL 15

    Expert Comment

    by:Naser Gabaj

    I never try it before, but I believe this tool can do the job for you

    Good luck
    LVL 9

    Accepted Solution

    copy code below into a macro

    This page will show you how to add a button to the toolbar

    Private Declare Function GetTempPath Lib "kernel32" _
             Alias "GetTempPathA" (ByVal nBufferLength As Long, _
             ByVal lpBuffer As String) As Long
          Private Declare Function GetTempFileName Lib "kernel32" _
             Alias "GetTempFileNameA" (ByVal lpszPath As String, _
             ByVal lpPrefixString As String, ByVal wUnique As Long, _
             ByVal lpTempFileName As String) As Long
          Private Function CreateTempFile(sPrefix As String) As String
             Dim sTmpPath As String * 512
             Dim sTmpName As String * 576
             Dim nRet As Long
             nRet = GetTempPath(512, sTmpPath)
             If (nRet > 0 And nRet < 512) Then
                nRet = GetTempFileName(sTmpPath, sPrefix, 0, sTmpName)
                If nRet <> 0 Then
                   CreateTempFile = Left$(sTmpName, _
                      InStr(sTmpName, vbNullChar) - 1)
                End If
             End If
          End Function
    Sub GetSelected()
    Dim messages()
    Dim mail As MailItem
    Dim tmpPath
    Dim currentMail As MailItem
    If Not IsEmpty(ActiveExplorer.Selection) Then
        For Each CurrentItem In ActiveExplorer.Selection
            If CurrentItem.Class = olMail Then
                If mail Is Nothing Then Set mail = Application.CreateItem(olMailItem)
                    counter = counter + 1
                    Set currentMail = CurrentItem
                    tmpPath = CreateTempFile("OL")
                    currentMail.SaveAs tmpPath, olMSG
                    mail.Attachments.Add tmpPath
                End If
    End If
    mail.BodyFormat = olFormatHTML
    mail.Subject = "Emails forwarded"
    mail.Body = "emails attached"
    mail.To = ""
    msgbox "Finished"
    end sub

    Open in new window


    Author Closing Comment

    by:Erik Curtis
    This works just as it should!

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Enabling OSINT in Activity Based Intelligence

    Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

    Check out this infographic on what you need to make a good email signature that will work perfectly for your organization.
    Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
    Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
    This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    10 Experts available now in Live!

    Get 1:1 Help Now