autoforward messages from a folder while deleting the message body

K

Kanika

i have created a rule for all new mails to come in a folder.
i want all mails from this folder to be forwarded to a particular emailid
but without the msg body or without the to,from,sent subject field that is
displayed while forwarding a msg.
my purpose is to auto forward the attachments to my vendor ,without him
knowing the emailid from where i have recvd. them.

PLS. HELP!!!!!!!!!!!!!!!
 
J

JP

Why not create a macro that saves the attachment, creates a new email,
attaches the attachment and sends the email? Then of course you could
delete the saved file at the end.


HTH,
JP
 
K

Kanika

pls help me with the macro

JP said:
Why not create a macro that saves the attachment, creates a new email,
attaches the attachment and sends the email? Then of course you could
delete the saved file at the end.


HTH,
JP
Click to expand...
 
J

JP

If you don't have anything in your ThisOutlook Session module, simply
paste in this code and customize as needed. This will auto-move all
incoming emails to Inbox\My Folder, then forward a copy to
"(e-mail address removed)" with the attachment from the original email,
as well as other misc parameters you can see below.


Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

If item.Class = olMail Then

Dim MyFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim Msg As Outlook.MailItem
Dim NewMsg As Outlook.MailItem
Dim MyAttachments As Outlook.Attachments

Const AttPath As String = "C:\"

Set objNS = GetNamespace("MAPI")

' set reference to folder to store new items,
' if folder doesn't exist, create it
On Error Resume Next
Set MyFolder = objNS.Folders("Inbox").Folders("My Folder")
On Error GoTo 0
If MyFolder Is Nothing Then
Set MyFolder = objNS.Folders("Inbox").Add("My Folder",
olFolderInbox)
End If

' I like Msg better than item, move it to our folder!
Set Msg = item
Msg.Move MyFolder

Set MyAttachments = Msg.Attachments

With MyAttachments.item(1)
.SaveAsFile AttPath & .DisplayName
End With

Set NewMsg = Msg.Forward

With NewMsg
.Body = vbCr & "Here is the message I got. I'm sending it to you.
Enjoy!"
.To = "(e-mail address removed)"
.Subject = "EMail you requested"
.Importance = olImportanceHigh
.Attachments.Add AttPath & MyAttachments.item(1).DisplayName
'.Display
.Send
End With
End If

ExitProc:
Set NewMsg = Nothing
Set MyAttachments = Nothing
Set Msg = Nothing
Set MyFolder = Nothing
Set objNS = Nothing
On Error Resume Next
Kill AttPath & MyAttachments.item(1).DisplayName
On Error GoTo 0
End Sub



HTH,
JP
 
K

Kanika

the code's not working

JP said:
If you don't have anything in your ThisOutlook Session module, simply
paste in this code and customize as needed. This will auto-move all
incoming emails to Inbox\My Folder, then forward a copy to
"(e-mail address removed)" with the attachment from the original email,
as well as other misc parameters you can see below.


Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

If item.Class = olMail Then

Dim MyFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim Msg As Outlook.MailItem
Dim NewMsg As Outlook.MailItem
Dim MyAttachments As Outlook.Attachments

Const AttPath As String = "C:\"

Set objNS = GetNamespace("MAPI")

' set reference to folder to store new items,
' if folder doesn't exist, create it
On Error Resume Next
Set MyFolder = objNS.Folders("Inbox").Folders("My Folder")
On Error GoTo 0
If MyFolder Is Nothing Then
Set MyFolder = objNS.Folders("Inbox").Add("My Folder",
olFolderInbox)
End If

' I like Msg better than item, move it to our folder!
Set Msg = item
Msg.Move MyFolder

Set MyAttachments = Msg.Attachments

With MyAttachments.item(1)
.SaveAsFile AttPath & .DisplayName
End With

Set NewMsg = Msg.Forward

With NewMsg
.Body = vbCr & "Here is the message I got. I'm sending it to you.
Enjoy!"
.To = "(e-mail address removed)"
.Subject = "EMail you requested"
.Importance = olImportanceHigh
.Attachments.Add AttPath & MyAttachments.item(1).DisplayName
'.Display
.Send
End With
End If

ExitProc:
Set NewMsg = Nothing
Set MyAttachments = Nothing
Set Msg = Nothing
Set MyFolder = Nothing
Set objNS = Nothing
On Error Resume Next
Kill AttPath & MyAttachments.item(1).DisplayName
On Error GoTo 0
End Sub



HTH,
JP
Click to expand...
 
K

Kanika

the code is not working

JP said:
If you don't have anything in your ThisOutlook Session module, simply
paste in this code and customize as needed. This will auto-move all
incoming emails to Inbox\My Folder, then forward a copy to
"(e-mail address removed)" with the attachment from the original email,
as well as other misc parameters you can see below.


Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

If item.Class = olMail Then

Dim MyFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim Msg As Outlook.MailItem
Dim NewMsg As Outlook.MailItem
Dim MyAttachments As Outlook.Attachments

Const AttPath As String = "C:\"

Set objNS = GetNamespace("MAPI")

' set reference to folder to store new items,
' if folder doesn't exist, create it
On Error Resume Next
Set MyFolder = objNS.Folders("Inbox").Folders("My Folder")
On Error GoTo 0
If MyFolder Is Nothing Then
Set MyFolder = objNS.Folders("Inbox").Add("My Folder",
olFolderInbox)
End If

' I like Msg better than item, move it to our folder!
Set Msg = item
Msg.Move MyFolder

Set MyAttachments = Msg.Attachments

With MyAttachments.item(1)
.SaveAsFile AttPath & .DisplayName
End With

Set NewMsg = Msg.Forward

With NewMsg
.Body = vbCr & "Here is the message I got. I'm sending it to you.
Enjoy!"
.To = "(e-mail address removed)"
.Subject = "EMail you requested"
.Importance = olImportanceHigh
.Attachments.Add AttPath & MyAttachments.item(1).DisplayName
'.Display
.Send
End With
End If

ExitProc:
Set NewMsg = Nothing
Set MyAttachments = Nothing
Set Msg = Nothing
Set MyFolder = Nothing
Set objNS = Nothing
On Error Resume Next
Kill AttPath & MyAttachments.item(1).DisplayName
On Error GoTo 0
End Sub



HTH,
JP
Click to expand...
 
K

Kanika

hi
I am recvng an error in this line
Set MyFolder = objNS.Folders("Inbox").Add("My Folder", olFolderInbox)
 
K

Kanika

hi
I am recvng an error in this line
Set MyFolder = objNS.Folders("Inbox").Add("My Folder", olFolderInbox)
 
K

Kanika

i am transfering a few mails to one of the folders in outlook through rules
and then write the code for forwarding mails from that folder with the
attachments and a replced body text.pls help.

is there also a way by which i can only hide the email address from where i
have recvd. as i will have to send this back to the originator .thanx
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Can I use a macro within Outlook ? 2
body of message is deleted during forwarding 1
VBA to save selected messages in folder to user prompt destination as .msg 0
Script help - retain forwarded email body & location of script 5
How to change message format while forwarding a mail 1
Outlook Looking for macro to save multiple emails as .msg to folder and extracting the invoice ref. from the email body as the filename 4
Reply with custom form & selected data from message body 2
Turning a rule on with a text message & message alerts 5

Top