Outlook Macro to Forward Multiple Emails
Our workgroup has been requested to send emails a specific subject that
are saved in our personal folders in Outlook 2003 to an email address set up
for document retention purposes. Each individual email must be forwarded
separately.
I have attempted to use this macro I found, but I can't get it to send more
than one email at a time. Is there a way to change it to send numerous
highlighted emails (i.e., 10 at a time) from Outlook?
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
End Select
Set objApp = Nothing
End Function
Sub ADDASSPAM()
Dim myOlApp As New Outlook.Application
Dim myItem, myForward As Object
Set myItem = GetCurrentItem()
Set myForward = myItem.Forward
myForward.To = "
Set myForward.SaveSentMessageFolder =
Application.GetNamespace("MAPI").GetDefaultFolder( olFolderDeletedItems)
myForward.Send
Set myItem = Nothing
Set myForward = Nothing
End Sub
|