I have approximately 14,000 Outlook invitations in a Outlook folder that was generated from a legal discovery. Counsel would like all these imported into a normal "Calendar View" (turning the invite into an actual calendar entry). The two solutions I came up with is either require forwarding the invitation to a separate account (and auto accept) or use the Outlook "Copy to My Calendar" option which is what I'm hoping to accomplish.
Copied below is code I found to FORWARD all selected invitations in the Outlook folder. My concern with the forward is that it will notify the meeting organizer which we certainly don't want. I'm hoping someone can suggested a modification so this triggers "Copy to My Calendar" instead. Any help or guidance would greatly be appreciated!
Sub BatchForwardMultipleCalendarItems()
Dim objSelection As Outlook.Selection
Dim i As Integer
Dim objCalendarItem As Outlook.AppointmentItem
Dim objMail As Outlook.MailItem
Set objSelection = Outlook.Application.ActiveExplorer.Selection
For i = objSelection.Count To 1 Step -1
Set objCalendarItem = objSelection.Item(i)
Set objMail = Outlook.Application.CreateItem(olMailItem)
With objMail
.Attachments.Add objCalendarItem
'Change the recipient's email address
.Recipients.Add ("shelly#datanumen.com")
.Recipients.ResolveAll
.Subject = objCalendarItem.Subject
.Body = "Type body here ...."
.Send
End With
Next i
End Sub
Instead of creating a new mail item in the code and just sending it out with an attached appointment item:
Set objMail = Outlook.Application.CreateItem(olMailItem)
You can use the AppointmentItem.ForwardAsVcal method which forwards the AppointmentItem as a vCal (virtual calendar item). A MailItem object that represents the new mail item to which the calendar information is attached is returned back.
There is no other way available in the Outlook object model.
I have been tasked to create an automated report system where an report from Google Data Studios are uploaded to specific projects (On a site called Basecamp). The reports always include both a report within the body of the e-mail and an attached PDF file. The are sent to a Gmail account (data studios refuse to schedule towards a non-Google account). The filters within Gmail doesnt really work well with the Basecamp system so I use filters to re-route them towards a Outlook account. There I use rules to send each e-mail towards the correct client within Basecamp.
Here comes the problem, Basecamp shows both the body of the e-mail AND the attached PDF version which makes us show duplicates.
Is there a way to create a macro that first deletes all attachments (or body of an e-mail) and THEN forward the e-mail.
It cant be done manually it have to be a rule that does it automaticaly. Keep in mind that I am not a coder and have never done anything like this so please keep it simple for my dumb brain!
Thank you in advance!
Marcus
PS: I found a code that seems to be what I am after.
Public WithEvents ReceivedItems As Outlook.Items
Private Sub Application_Startup()
Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
Dim xForwardMail As Outlook.MailItem
Dim xEmail As MailItem
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xEmail = Item
If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub 'change subject text to your need
If xEmail.Attachments.Count = 0 Then Exit Sub
Set xForwardMail = xEmail.Forward
With xForwardMail
.HTMLBody = ""
With .Recipients
.Add "skyyang#addin88.com" 'change address to your own
.ResolveAll
End With
.Send
End With
End Sub
I am trying to get that code to work, and changes the subject to a specific word and then route it to a final e-mail account that then filters out to correct clients. However the code doesnt seem to work, it DOES forward the e-mail but the attachment is still there. The code was found at https://www.extendoffice.com/documents/outlook/5359-outlook-forward-attachment-only.html#a1
It seems you need to modify the code slightly:
Public WithEvents ReceivedItems As Outlook.Items
Private Sub Application_Startup()
Set ReceivedItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub ReceivedItems_ItemAdd(ByVal Item As Object)
Dim xForwardMail As Outlook.MailItem
Dim xEmail As MailItem
Dim myattachments as Outlook.Attachments
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xEmail = Item
If InStrRev(UCase(xEmail.Subject), UCase("kto feature")) = 0 Then Exit Sub 'change subject text to your need
If xEmail.Attachments.Count = 0 Then Exit Sub
Set xForwardMail = xEmail.Forward
Set myattachments = xForwardMail.Attachments
While myattachments.Count > 0
myattachments.Remove 1
Wend
With xForwardMail
.HTMLBody = ""
With .Recipients
.Add "skyyang#addin88.com" 'change address to your own
.ResolveAll
End With
.Send
End With
End Sub
The Remove method of the Attachments class removes an object from the collection.
I receive mails, from two senders, with two subjects, to a specific address.
I set up a rule:
from: example#example.com or example2#example2.com
sent to: me#me.com
and with: Company return doc or Daily document Country in the subject
except if the subject contains "FW:"
to run a script:
Sub myRuleMacro(Item As Outlook.MailItem)
Dim selEmail As Outlook.MailItem
Set selEmail = ActiveExplorer.Selection.Item(1).Forward
selEmail.Recipients.Add "address#address.pl"
selEmail.Send
Set selEmail = Nothing
End Sub
The script works for the selected email but to select it I need to click it manually, or if any other email is already clicked/marked it forwards this marked email, not the one from the rule.
How to choose the mail from the rule to trigger the macro?
Basically I need the solution which will forward the email. I cannot use the forwarding rule due to company safety policies.
You all most got it, it should be
Example
Option Explicit
Public Sub myRuleMacro(Item As Outlook.MailItem)
Dim selEmail As Outlook.MailItem
If TypeOf Item Is Outlook.MailItem Then
Set selEmail = Item.Forward
selEmail.Subject = Item.Subject
selEmail.HTMLBody = Item.HTMLBody
selEmail.Recipients.Add "address#address.pl"
selEmail.Save
selEmail.Send
End If
End Sub
No need for Selection.Item and make sure to save it before sending it
The email that the rule is triggered on is already being passed to the sub Item as Outlook.MailItem -- Sub myRuleMacro(**Item As Outlook.MailItem**)
You're not using this provided item and selecting a DIFFERENT item when you use Set selEmail = ActiveExplorer.Selection.Item(1).Forward
You should be able to simply use Item.Forward
Try
Sub myRuleMacro(Item As Outlook.MailItem)
Dim newForward as MailItem
Set newForward = Item.Forward
newForward.Recipients.Add "address#address.pl"
newForward.Send
End Sub
EDITED: To include updates by #Tony Dallimore in comments.
Thanks to the excellent assistance given on this site I found the code below - which works perfectly. I cannot (embarrassingly enough) figure out how to loop through the entire Inbox to move all emails (rather than selection as the code below does).
Any assistance most gratefully appreciated it.
John
Sub MoveWithRecDate()
' Moves selected emails with correct dates maintained
Dim objNS As Outlook.NameSpace
Dim Session As Redemption.RDOSession
Dim objRDOFolder As Redemption.RDOFolder
Dim objItem As Outlook.MailItem
Dim objRDOMail As Redemption.RDOMail
Set objNS = Application.GetNamespace("MAPI")
Set Session = CreateObject("Redemption.RDOSession")
Session.Logon
Set inbox = Session.GetDefaultFolder(olFolderInbox)
Set objRDOFolder = inbox.Parent.Folders("Cabinet")
For Each objItem In Application.ActiveExplorer.Selection
Set objRDOMail = Session.GetMessageFromID(objItem.EntryID)
objRDOMail.Move objRDOFolder
Next
End Sub
I had not heard of Redemption before reading your question. It looks very interesting so thank you for the information; I will try it next time I need to write a new Outlook macro.
I assume from the lack of an answer to your question that few others use Redemption either.
The Redemption website implies that the structure of Redemption code will be almost identical to standard Outlook code. I can only recall once writing a macro which operated on user selected items but my recollection is that the code looked like yours. The code below is standard Outlook but I hope that is enough for you to create the equivalent Redemption code.
You macro has the comment ' Moves selected emails with correct dates maintained. This implies you think there is a method by which emails can be moved so that dates are not maintained. I do not know such a method.
The code below examines every item in the Inbox. I did not want to move everything out of my Inbox so I have skipped items that are not mail items and are not from a specific sender.
I hope this is enough to get you going.
Sub MoveWithRecDate()
Dim FolderDest As MAPIFolder
Dim ItemToBeMoved As Boolean
Dim ItemCrnt As Object
Dim FolderSrc As MAPIFolder
Set FolderSrc = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set FolderDest = FolderSrc.Parent.Folders("Cabinet")
For Each ItemCrnt In FolderSrc.Items
ItemToBeMoved = True ' Assume item to be moved until discover otherwise
With ItemCrnt
If .Class = olMail Then
If .SenderEmailAddress <> "noreply#which.co.uk" Then
' Mail item not from Which
ItemToBeMoved = False
End If
Else
' Not mail item so do not move
ItemToBeMoved = False
End If
If ItemToBeMoved Then
.Move FolderDest
End If
End With
Next
End Sub
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 4 years ago.
Improve this question
I have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email.
It is working for me, except sometimes the rule fails and Outlook deactivates it.
Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day.
I would love to fix this once and for all.
This code showed me the different TypeNames that were in my Inbox:
Public Sub GetTypeNamesInbox()
Dim myOlItems As Outlook.Items
Set myOlItems = application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
Dim msg As Object
For Each msg In myOlItems
Debug.Print TypeName(msg)
'emails are typename MailItem
'Meeting responses are typename MeetingItem
'Delivery receipts are typename ReportItem
Next msg
End Sub
HTH
I use the following VBA code snippet in other Office Applications, where the Outlook Library is directly referenced.
' Outlook Variables
Dim objOutlook As Outlook.Application: Set objOutlook = New Outlook.Application
Dim objNameSpace As Outlook.NameSpace: Set objNameSpace = objOutlook.GetNamespace("MAPI")
Dim objFolder As MAPIFolder: Set objFolder = objNameSpace.PickFolder()
Dim objMailItem As Outlook.MailItem
Dim iCounter As Integer: iCounter = objFolder.Items.Count
Dim i As Integer
For i = iCounter To 1 Step -1
If TypeOf objFolder.Items(i) Is MailItem Then
Set objMailItem = objFolder.Items(i)
With objMailItem
etc.
have written a message handler function in Outlook's Visual Basic (we're using Outlook 2003 and Exchange Server) to help me sort out incoming email. It is working for me, except sometimes the rule fails and Outlook deactivates it. Then I turn the rule back on and manually run it on my Inbox to catch up. The rule spontaneously fails and deactivates several times a day. I would love to fix this once and for all.
Here is the code stripped of the functionality, but giving you an idea of how it looks:
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
' Reference the items in the Inbox. Because myOlItems is declared
' "WithEvents" the ItemAdd event will fire below.
' Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) = "MailItem" Then
MyMessageHandler Item
End If
End Sub
Public Sub MyMessageHandler(ByRef Item As MailItem)
Dim strSender As String
Dim strSubject As String
If TypeName(Item) <> "MailItem" Then
Exit Sub
End If
strSender = LCase(Item.SenderEmailAddress)
strSubject = Item.Subject
rem do stuff
rem do stuff
rem do stuff
End Sub
One error I get is "Type Mismatch" calling MyMessageHandler where VB complains that Item is not a MailItem. Okay, but TypeName(Item) returns "MailItem", so how come Item is not a MailItem?
Another one I get is where an email with an empty subject comes along. The line
strSubject = Item.Subject
gives me an error. I know Item.Subject should be blank, but why is that an error?
Thanks.
My memory is somewhat cloudy on this, but I believe that a MailItem is not a MailItem when it is something like a read receipt. (Unfortunately, the VBA code that demonstrated this was written at another job and isn't around now.)
I also had code written to process incoming messages, probably for the same reason you did (too many rules for Exchange, or rules too complex for the Rules Wizard), and seem to recall running into the same problem you have, that some items seemed to be from a different type even though I was catching them with something like what you wrote.
I'll see if I can produce a specific example if it will help.
There are many types of items that can be seen in the default Inbox.
In the called procedure, assign the incoming item to an Object type variable. Then use TypeOf or TypeName to determine if it is a MailItem. Only then should your code perform actions that apply to emails.
i.e.
Dim obj As Object
If TypeName(obj) = "MailItem" Then
' your code for mail items here
End If
Dim objInboxFolder As MAPIFolder
Dim oItem As MailItem
Set objInboxFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each Item In objInboxFolder.Items
If TypeName(Item) = "MailItem" Then
Set oItem = Item
next
why not use a simple error handler for the code? Seriously. You could write an error for each read of a property or object that seems to fail. Then have it Resume no matter what. No need for complex error handling. Think of a test that shows an empty subject. Since you don't know what value it will return, if any, and it seems to error on an empty or blank subject, you need to picture it as a simple test with a possible error. Run the test as an if statement (one in which you will get an error anyway), and have the program resume on error.
On Error Resume Next
If object.subject = Null 'produces an error when subject is null, otherwise allows a good read
strSubject = "" 'sets the subject grab string to a null or empty string as a string
Else
strSubject = object.subject 'Sets the subject grab string to the subject of the message\item
End If