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

Outlook Macro to Forward Multiple Emails
 

Selection is a collection. You must iterate it instead of always using 1 as
the index.

I'd restructure the code to loop Selection and put everything in one Sub.

Never use a new Outlook.Application object in an Outlook macro. Use the
intrinsic Application object.

For Each oItem In Application.ActiveExplorer.Selection
'now you can forward every one of the items that's selected.
Next

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Jim" wrote in message
...
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

Outlook Macro to Forward Multiple Emails
 

Thanks for the quick response. Unfortunately, my VBA skills are
rusty/lacking, so where would the "For Each oItem In
Application.ActiveExplorer.Selection" go in the code?

"Ken Slovak - [MVP - Outlook]" wrote:

Selection is a collection. You must iterate it instead of always using 1 as
the index.

I'd restructure the code to loop Selection and put everything in one Sub.

Never use a new Outlook.Application object in an Outlook macro. Use the
intrinsic Application object.

For Each oItem In Application.ActiveExplorer.Selection
'now you can forward every one of the items that's selected.
Next

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Jim" wrote in message
...
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

Outlook Macro to Forward Multiple Emails
 

The code has to be restructured, there's really no good place for that loop
as it currently is structured.

Something like this, where GetCurrentItem is the macro you call:

Sub GetCurrentItem()
Dim oItem As Object

On Error Resume Next

Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
For Each oItem In Application.ActiveExplorer.Selection
'now you can forward every one of the items that's selected.
call ADDASSPAM(oItem)
Next
Case "Inspector"
call ADDASSPAM(ActiveInspector.CurrentItem)
Case Else
End Select

Set oItem = Nothing
End Sub

Sub ADDASSPAM(myItem As Object)
Dim myForward As Object

Set myForward = myItem.Forward

myForward.To = "
Set myForward.SaveSentMessageFolder = _
Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems)

myForward.Send

Set myForward = Nothing
End Sub


--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Jim" wrote in message
...
Thanks for the quick response. Unfortunately, my VBA skills are
rusty/lacking, so where would the "For Each oItem In
Application.ActiveExplorer.Selection" go in the code?

Outlook Macro to Forward Multiple Emails
 

Thanks Ken. The macro will now work on multiple emails, but I get a message
box for each and every email that says "A program is trying to automatically
send an emial on your behalf. Do you want to allow this?" and has yes/no
buttons. Hitting "yes" for each email defeats the purpose of the macro. Is
there a way to bypass this message? I don't have admin privileges on either
my machine or the exchange server.

"Ken Slovak - [MVP - Outlook]" wrote:

The code has to be restructured, there's really no good place for that loop
as it currently is structured.

Something like this, where GetCurrentItem is the macro you call:

Sub GetCurrentItem()
Dim oItem As Object

On Error Resume Next

Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
For Each oItem In Application.ActiveExplorer.Selection
'now you can forward every one of the items that's selected.
call ADDASSPAM(oItem)
Next
Case "Inspector"
call ADDASSPAM(ActiveInspector.CurrentItem)
Case Else
End Select

Set oItem = Nothing
End Sub

Sub ADDASSPAM(myItem As Object)
Dim myForward As Object

Set myForward = myItem.Forward

myForward.To = "
Set myForward.SaveSentMessageFolder = _
Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems)

myForward.Send

Set myForward = Nothing
End Sub


--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Jim" wrote in message
...
Thanks for the quick response. Unfortunately, my VBA skills are
rusty/lacking, so where would the "For Each oItem In
Application.ActiveExplorer.Selection" go in the code?

Outlook Macro to Forward Multiple Emails
 

If this is VBA running in the Outlook VBA project in Outlook 2003 you should
not get the security prompts. However, for your options with the security
see http://www.outlookcode.com/d/sec.htm

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Absolute Beginner's Guide to Microsoft Office Outlook 2003
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Jim" wrote in message
...
Thanks Ken. The macro will now work on multiple emails, but I get a
message
box for each and every email that says "A program is trying to
automatically
send an emial on your behalf. Do you want to allow this?" and has yes/no
buttons. Hitting "yes" for each email defeats the purpose of the macro.
Is
there a way to bypass this message? I don't have admin privileges on
either
my machine or the exchange server.