I have the following macro;
Private WithEvents MySents As Outlook.Items
Private Sub Application_Startup()
Set MySents = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub MySents_ItemAdd(ByVal Item As Object)
Dim objNS As Outlook.NameSpace
Dim targetFolder As Outlook.MAPIFolder
Set objNS = Outlook.GetNamespace("MAPI")
If TypeOf Item Is Outlook.MailItem Then
If Item.SenderName = "Sender 1" Then
Set targetFolder = objNS.Folders("Folder 1").Folders("Sent Items")
Set newItem = Item.Copy
newItem.Move targetFolder
End If
If Item.SenderName = "Sender 2" Then
Set targetFolder = objNS.Folders("Folder 2").Folders("Sent Items")
Set newItem = Item.Copy
newItem.Move targetFolder
End If
End If
End Sub
Last week this worked fine. Now when the macro runs I get a "Runtime error -2147221241 (80040107) The operation failed"
Looking at the debugger it fails on;
If Item.SenderName =
If I have a look at Items in the watch window most properties have "The operation failed" in the values.
Most strange about this is the fact that the message still gets copied anyway.
Can anyone see something silly I am doing?
The SenderName property returns a String indicating the display name of the sender for the Outlook item. It is set after the mail item has been sent. New items (unsent) don't have this property set.
You may consider using the SaveSentMessageFolder property which allows to set a Folder object that represents the folder in which a copy of the e-mail message will be saved after being sent. For example, you may handle the ItemSend event where you can set this property.
Sub SetSentFolder()
Dim myItem As Outlook.MailITem
Dim myResponse As Outlook.MailITem
Dim mpfInbox As Outlook.Folder
Dim mpf As Outlook.Folder
Set mpfInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set mpf = mpfInbox.Folders.Add("SaveMyPersonalItems")
Set myItem = Application.ActiveInspector.CurrentItem
Set myResponse = myItem.Reply
myResponse.Display
myResponse.To = "Eugene Astafiev"
Set myResponse.SaveSentMessageFolder = mpf
myResponse.Send
End Sub
Related
I have a boss who gets mass amount of emails and assigns them categories. I need those emails to move to a different pst file inbox named the category after they are assigned a category. I don't need to auto create inboxes.
The code I have moves an email to a folder within the default inbox folder that the category is assigned. I need it to move to another pst file inbox.
The person is using POP3. I know IMAP would be better but they are set in their ways due to old employees "accidental" deleting of emails.
Private WithEvents objInboxFolder As Outlook.Folder
Private WithEvents objInboxItems As Outlook.Items
'Process inbox mails
Private Sub Application_Startup()
Set objInboxFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInboxFolder.Items
End Sub
'Occurs when changing item
Private Sub objInboxItems_ItemChange(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objTargetFolder As Outlook.Folder
If TypeOf Item Is MailItem Then
Set objMail = Item
'Move mails based on color category
If InStr(objMail.Categories, "Followup") > 0 Then
Set objTargetFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Followup")
objMail.Move objTargetFolder
ElseIf InStr(objMail.Categories, "Business") > 0 Then
Set objTargetFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Business")
objMail.Move objTargetFolder
End If
End If
End Sub
I need those emails to move to a different pst file inbox named just like the category after they assign it to a category.
First of all, other pst files should be added to the profile. Otherwise, you need to add them using the AddStore/AddStoreEx methods in case of pst files stored on the disk.
If other stores are just shared folders you need to use the NameSpace.GetSharedDefaultFolder method which returns a Folder object that represents the specified default folder for the specified user. This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders (for example, their shared Inbox folder).
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Dan Wilson")
myRecipient.Resolve
If myRecipient.Resolved Then
Call ShowCalendar(myNamespace, myRecipient)
End If
End Sub
Sub ShowCalendar(myNamespace, myRecipient)
Dim CalendarFolder As Outlook.Folder
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
CalendarFolder.Display
End Sub
Finally, when stores are available you can use the Stores property of the Namespace class which returns a Stores collection object that represents all the Store objects in the current profile.
Sub EnumerateStores()
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oRoot As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oRoot = oStore.GetRootFolder
Debug.Print (oRoot.FolderPath)
Debug.Print (oRoot.Name)
Next
End Sub
I'm trying to move the received new mails in shared inbox excluding the (Re: and FWD:) to "In progress folder". When I execute it's not working.
Error popping up in this line olReply.Move fldr
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Public WithEvents olItems As Items
Private Sub Application_Startup()
Set olItems = Session.Folders("xxx#xxx.com").Folders("Inbox").Items
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim olReply As MailItem
Dim fldr As Outlook.MAPIFolder
If Item.Class = olMail Then
If Len(Item.ConversationIndex) > 44 Then
Exit Sub
Else
Set fldr = Outlook.Session.Folders("xxx#xxx.com").Folders("In Progress")
olReply.Move fldr
End If
End If
End Sub
I Figured out the code myself and it works perfectly. The below-mentioned code reads through the new mails which hits the shared mailbox and move to another folder if it is a new mail and skips Conversation mails.
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Public WithEvents olItems As Items
Private Sub Application_Startup()
Set olItems = Session.Folders("xxxxx#xxxx.com").Folders("Inbox").Items
End Sub
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim olNameSpace As NameSpace
Set olNameSpace = GetNamespace("MAPI")
Dim olReply As MailItem
Dim olObj As Object
Dim olDestFolder As Folder
If Item.Class = olMail Then
If Len(Item.ConversationIndex) > 44 Then ' Checks if the mail has conversation
Exit Sub
Else
Set olDestFolder = olNameSpace.Folders("xxx#xx.com").Folders("In Progress")'Set destination folder
Item.Move olDestFolder ' move to InProgress folder
End If
End If
End Sub
We organize emails within a shared mailbox. There are folders for each area, then a sub folder for each specific location.
I am trying to check the subject line of incoming email to move the email to its proper folder.
The thing to look for in the subject line is similar to "%%-%%" the percents being letters. We have over 900 locations and I would like to not have to create 900 rules.
Sub MoveToFolder(Item As Outlook.MailItem)
Dim Subject As String
Subject = Item.Subject
Dim FolderToMoveTo As Outlook.Folder
Set FolderToMoveTo = GetFolder("KX-BH")
If (CheckSubject(Subject, "KX-BH")) Then
Item.Move (FolderToMoveTo)
End If
End Sub
Function CheckSubject(Subject As String, PatternToCheck As String)
Dim ObjRegExp As RegExp
Dim ObjMatch As Match
Set ObjRegExp = New RegExp
ObjRegExp.Pattern = PatternToCheck
If (ObjRegExp.Text(Subject) = True) Then
CheckSubject = True
End If
End Function
Function GetFolder(ByVal FolderName As String) As Outlook.Folder
Dim ObjFolder As Outlook.Folder
Set ObjFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders(FolderName)
Set GetFolder = ObjFolder
End Function
It looks like you are interested in the NewMailEx event of the Application class which is fired when a new item is received in the Inbox. The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item.
Public WithEvents outApp As Outlook.Application
Sub Intialize_Handler()
Set outApp = Application
End Sub
Private Sub outApp_NewMailEx(ByVal EntryIDCollection As String)
Dim mai As Outlook.MailItem
Set mai = Application.Session.GetItemFromID(strEntryId)
MsgBox mai.Subject
MoveToFolder(mai)
End Sub
I'm trying toremove the RES: and ENC: (response and forwarding in Portuguese) upon receiving a message (by rule already sent to the folder referenced in the code).
Although the code works, in msgbox the subject is displayed without the prefixes, it does not refresh the subject.
I guess it has something to do with the ByVal or ByRef; i've tried both, and it goes as I described with ByVal, while with the byRef doesn't even run.
Here's the code:
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems =
objectNS.GetDefaultFolder(olFolderInbox).Folders("TESTA").Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem
Dim assunto As String
If TypeName(Item) = "MailItem" Then
assunto = Replace(Replace(Item.Subject, "RES: ", ""), "ENC: ", "")
Item.Subject = assunto
MsgBox (assunto)
End If
End Sub
Just forget ByVal and ByRef.
Add this string after last MsgBox:
Item.Save
How do I show a MsgBox or alert upon receiving a message with a specified subject or sender?
I put this procedure in ThisOutlookSession block.
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim myMail As MailItem
Dim name As String
If TypeOf Item Is MailItem Then
Set myMail = Item
If myMail.Subject Like "*Hello world*" And myMail.Categories = "" Then
MsgBox "Message", vbInformation, "approved"
MailDate = myMail.ReceivedTime
myMail.Categories = "CZEART"
myMail.MarkAsTask (olMarkNoDate)
myMail.Save
End If
End If
End Sub
To test the code, open a mailitem with the required conditions then step through this.
Option Explicit
Private Sub test()
Dim currItem As MailItem
Set currItem = ActiveInspector.currentItem
olInboxItems_ItemAdd currItem
End Sub
Likely though you need this in the ThisOutlookSession module.
Option Explicit
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
http://www.outlookcode.com/article.aspx?id=62