View Single Post
  #1  
Old December 6th 06, 10:33 PM posted to microsoft.public.outlook.program_vba
Jim
external usenet poster
 
Posts: 230
Default 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

Ads