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
Next
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
oMail.Display
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
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.
Diane Poremsky says
i have a macro here somewhere that walks all folders. Here it is: Save attachments - it will give you an idea of how you need to walk the folders to hit each one.
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
'move
else
end if
oh, i see the on error resume next is commented out. Does it work if you remove the '?
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
Dieter
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.