Last reviewed on July 2, 2012   —  6 Comments

This macro demonstrates how to pick up the sender's address and use it for a new message. This was originally put together for a user who wanted to send email using the address of one of several shared mailbox automatically. Beyond using it for redirecting mail, it's more of a concept macro, showing how to grab the sender's address from an email email. Otherwise, it's probably not very useful to most people.

Public Sub SendFromAddressOfCurrentEmail()
    Dim Session As Outlook.NameSpace
    Dim currentExplorer As Explorer
    Dim Selection As Selection
    Dim currentItem As Object
    Dim currentMail As MailItem
    Dim smtpAddress As String

    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
     For Each currentItem In Selection
        If currentItem.Class = olMail Then
            Set currentMail = currentItem
            smtpAddress = currentMail.SenderEmailAddress
        End If
Dim oMail As Outlook.MailItem
' Send new message 
' Set oMail = Application.CreateItem(olMailItem)

'Send reply 
Set oMail = Application.ActiveExplorer.Selection(1).Reply

oMail.SentOnBehalfOfName = smtpAddress
End Sub

To send a message using the To address, change smtpAddress = currentMail.SenderEmailAddress to smtpAddress = currentMail.To

        If currentItem.Class = olMail Then
            Set currentMail = currentItem
            smtpAddress = currentMail.To
        End If


  1. Dieter Leyendecker says

    Hi Diane, I think you are the best address for my issue. I try to copy/move all eMails from a PST file into my mailbox by creating a new folder in my mailbox with similar name like the PST file. I'm facing 2 problems now:
    1. VBA is not reading all items from the PST file
    2. It only works with Item.Move - Item.Copy shows error message

    any idea? so my code works, but not completely as expected.

    Hope you find some time to answer

    Best regards from Switzerland

    • Diane Poremsky says

      What is the error message?
      Is there anything similar with the items the macro skips? If its moving every other messages, its how you are looping - you need to step backwards.

  2. Dieter Leyendecker says

    Hi Diane, sorry for the late reply. Error message while reading PST items is "Type mismatch" (see picture below). it reads 45 of 263 correctly. So I expect not a problem in read loop. The skipped messages look quite normal. It reads messages with attachments and long one as well as short ones. Very strange. any other idea?
    Routine looks like this:
    Public Sub CopyItems(fPstReadFolder, fDestFolder)
    Dim olItems As Outlook.Items
    Dim olItem As Outlook.MailItem
    Dim olFolder As Outlook.Folder
    Dim fPstFolder As Outlook.Folder
    Dim fPstSubFolder As Outlook.Folder
    Dim vFold As Variant
    Set olItems = fPstReadFolder.Items
    noOfMails = 0

    ' On Error Resume Next

    For Each olItem In olItems
    ' Move Mail to Folder
    olItem.Move fDestFolder
    noOfMails = noOfMails + 1

    Next olItem

    End Sub

    • Diane Poremsky says

      any meeting requests or non-mail items? This: For Each olItem In olItems is asking "for each mailitem in the folder..." Dimming olItem As object might work (will move everything) or use an if -

      For Each olItem In olItems
      if olitem = olmailitem then
      end if

      oh, i see the on error resume next is commented out. Does it work if you remove the '?

  3. Dieter Leyendecker says

    Thanks Diane, then Dimming was the problem. Changing item to object is the solution. And after changing the loop I could read all mails in a specific folder. Now my challenge is to find a solution to read all folders as I don't know how many levels of folders I need to work through. But I will find a solution, I'm sure. Many many thanks for your excellent and quick support.

Leave a Reply

Please post long or more complicated questions at OutlookForums by

If the Post Comment button disappears, press your Tab key.