autoforward messages from a folder while deleting the message body

  • Thread starter Thread starter Kanika
  • Start date Start date
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!!!!!!!!!!!!!!!
 
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
 
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...
 
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
 
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...
 
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...
 
hi
I am recvng an error in this line
Set MyFolder = objNS.Folders("Inbox").Add("My Folder", olFolderInbox)
 
hi
I am recvng an error in this line
Set MyFolder = objNS.Folders("Inbox").Add("My Folder", olFolderInbox)
 
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
 
Back
Top