I tried to create a script which searches the body text and sender name from an incoming email and if true move the email to a subfolder.
I tried to add this code to ThisOutlookSession but it is not working.
Public Sub MailtoFolder(Item As Outlook.MailItem)
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("xTest")
If InStr(Item.Body, "Test123") > 0 And Item.SenderName = "Jon" Then
Item.Move myDestFolder
End If
Set myDestFolder = Nothing
Set myInbox = Nothing
Set myNameSpace = Nothing
End Sub
Any ideas where I made a fault?
Your "Item" so far is not set.
If you wish to apply this to the currently opened e-mail, this would be e.g.
Set Item=Application.ActiveExplorer.Selection.Item(1)
If you wish to loop through all mails in your folder, you need to do exactly that:
Set myDestFolder = myInbox.Folders("xTest")
For Each mailItem in myDestFolder.Items
' ... do your magic
Next mailItem
Related
I have this:
Public Sub MoveMails (myitem As Outlook.mailItem)
...
End Sub
Runs automatically from a rule when I receive a new email.
I want launch this when I want. I tried with Call MoveMails but I don't know the argument for myitem As Outlook.mailItem.
I receive several mails. My idea is to move all. I have several conditions: filter by subject, body... and I move them to different folders.
Now that I know you wish to run this on multiple items at once.
Remove the parameter (myitem As Outlook.MailItem) from the sub to run on all items in the folder, or in a selection.
Copied from the code you posted (I've changed the formatting a bit too);
Public Sub Corrected()
'==========================================
'Declare variables:
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
'Set variables:
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("CHECK")
'===========================================
'Declare the variable MyItem but don't set it:
Dim MyItem As Outlook.MailItem
'Create a loop for all items in a certain folder:
For Each MyItem In myInbox 'Or for a subfolder use '...In MyInbox.Folders("FolderName")'
'Or to check selected items you could use the below:
'For Each MyItem in Application.ActiveExplorer.Selection
'if body contains alarm then move
If InStr(MyItem.Body, "alarm") > 0 Then
MyItem.Move myDestFolder
End If
'if subject contains Urgent move
If InStr(MyItem.Subject, "Urgent") > 0 Then
MyItem.Move myDestFolder
End If
'if body contains MASTER then categorize
If InStr(MyItem.Body, "MASTER") > 0 Then
MyItem.Categories = "Boss"
MyItem.Save
End If
Next MyItem 'This loops onto the next item in the selection or folder,
'so it checks them all automatically.
End Sub
I found a sub for selecting the current item here - it has options for whether the item is open in it's own window (inspector) or in the main Outlook window (explorer).
I recommend you add the custom function GetCurrentItem() from that page to your module and use that as your myitem parameter.
So to call the MoveMails sub Call Movemails(GetCurrentItem()).
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = 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
End Select
Set objApp = Nothing
End Function
Im stuck with problem to move active email to subfolder in inbox.
Need to replace ("xxxx#xxx.xxx") to something as olFolderInbox or inbox, etc without type specific email adress in VBA code.
Dim objMail As Outlook.MailItem
Dim objNS As Outlook.NameSpace
Dim objFolderItem As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
Set objFolderItem = objNS.Folders.Item("xxxx#xxx.xxx").Folders.Item("tmp")
objMail.Move objMoveItem
Try this
Option Explicit
Public Sub Exampls()
Dim olNs As Outlook.NameSpace
Set olNs = Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Dim Item As MailItem
Set Item = ActiveExplorer.selection(1)
Item.Move Inbox.Folders("Temp")
End Sub
Recently had an employee leave the company and decided to move a few thousand emails and events to the trash folder in Outlook. Thankfully, I can still recover them manually but I would prefer not have to do them in small batches..
I've got this code but it errors when I try to move items from the "Deleted Items" folder back to the Inbox.
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(Deleted Items)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("olFolderInbox")
Set myItem = myItems.Find("[SenderName] = 'John Smith'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
Thoughts?
You have to specify the deleted items folder like so:
Set myInbox = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
You can read more examples for specifying folders here and a list of other options here
Summary
I'm trying to add hyperlinks to tasks created from emails that I have moved to another folder.
The goal is to have the task contain a hyperlink to the Outlook item that was moved to a "Processed Email" folder".
Problem
I don't understand how to move a MailItem and then get its new EntryID after it moves.
The "naive" way doesn't work. After using the Move method to move a MailItem object, the EntryID property does not reflect a change in ID.
Details
Creating a hyperlink to an Outlook item using the format outlook:<EntryID> is easy enough if the Outlook item remains in the Inbox, since I can just get the EntryID of the object that I am linking to. However, Outlook changes the EntryID when an object is moved.
I want to understand how to get the updated ID so that I can construct an accurate link.
Example
The message boxes show the EntryID property of objMail returns the same value despite the fact that the object has moved. However, running a separate macro on the mail in the destination folder confirms that the EntryID has changed with the move.
Sub MoveObject(objItem As Object)
Select Case objItem.Class
Case olMail
Dim objMail As MailItem
Set objMail = objItem
MsgBox (objMail.EntryID)
Dim inBox As Outlook.MAPIFolder
Set inBox = Application.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim destFolder As Outlook.MAPIFolder
Set destFolder = inBox.Folders("Processed Email")
If (Application.ActiveExplorer().CurrentFolder.Name <> destFolder.Name) Then
objMail.Move destFolder
End If
MsgBox (objMail.EntryID)
End Select
End Sub
The Move method of the MailItem class returns an object that represents the item which has been moved to the designated folder. You need to check out the EntryID value of the returned object, not the source one.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Personal Mail")
Set myItem = myItems.Find("[SenderName] = 'Eugene Astafiev'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
Hello can you please elaborate your answer I am not able to understand it.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Here is my code and I need EntryID after moving.
Sub Movetest1()
Dim olApp As Outlook.Application
Dim olns As Outlook.NameSpace
Dim Fld As Folder
Dim ofSubO As Outlook.MAPIFolder
Dim myDestFolder As Outlook.Folder
Dim ofolders As Outlook.Folders
Dim objItems As Outlook.Items
Dim myRestrictItems As Outlook.Items
Dim i As Long
Dim myitem As Object
' Dim MailItem As Microsoft.Office.Interop.Outlook.MailItem
Dim MailItem, moveditem As Outlook.MailItem
Dim eid As String
Dim sid As Variant
Dim newEID As String
'---------------------------------------------------------------------------------------------------------
Set olApp = New Outlook.Application
Set olns = olApp.GetNamespace("MAPI")
For Each Fld In olns.Folders
If Fld.Name = "GSS Payables" Then
'
' MsgBox Fld.Name
' Debug.Print " - "; Fld.EntryID
Set Fld = olns.GetFolderFromID("000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000").Folders("Inbox")
Exit For
End If
Next
Set objItems = Fld.Items
eid = "000000009DA6D76FBE7A58489450CDF6094F592A0700A2457DC435B22448A832DB721D8185B1000000B620800000A2457DC435B22448A832DB721D8185B100007FF773270000"
sid = "000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000"
Set myDestFolder = Fld.Folders("Bhagyashri")
'Set myitem = objItems.Find("[SenderName]='Microsoft Outlook '")
Set MailItem = olns.GetItemFromID(eid)
Set moveditem = MailItem.Move(myDestFolder)
"giving error here
newID = moveditem.entryid
Debug.Print "newID -"; newID
' get mailitem.parent.storeid
MsgBox "done"
End
Use the following syntax:
Dim MoveToFolder As outlook.MAPIFolder
Dim MyItem As outlook.MailItem
Dim NewEntryID As String
NewEntryID = MyItem.Move(MoveToFolder).ENTRYID
After MyItem.Move is executed the new ENTRYID will be returned to the NewEntryID variable.
I am using the following vba code to get emails from my inbox folder and move them to a sub folder called suppliers. At the moment the emails are moved from my default email inbox, but I have an account called purcashing#hewden.co.uk and I want it to get the emails from this inbox and move it to the subfolder called Suppliers in this account.
can someone show me how I would alter GetDefaultFolder to make this happen. thanks
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Supplier")
Set myItem = myItems.Find("[Subject] = 'Introduction'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
Instead of using Namespace.GetDefaultFolder, retrieve the appropriate store from the Namespace.Stores collection and use Store.GetDefaultFolder.
I just used Dmitry's suggestion and it works like a charm.
Hope it helps \o/
Sub GetEmailFromNonDefaultInbox()
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim strFilter As String
' let the user choose which account to use
Set myAccounts = myOlApp.GetNamespace("MAPI").Stores
For i = 1 To myAccounts.count
res = MsgBox(myAccounts.Item(i).DisplayName & "?", vbYesNo)
If res = vbYes Then
Set myInbox = myAccounts.Item(i).GetDefaultFolder(olFolderInbox)
Exit For
End If
Next
If myInbox Is Nothing Then Exit Sub ' avoid error if no account is chosen
' query emails by subject
strFilter = "#SQL=""urn:schemas:httpmail:subject"" like '%YOUR SUBJECT%'"
Set myitems = myInbox.Items.Restrict(strFilter)
' show some feedback if no email is found
If myitems.count = 0 Then
MsgBox "Nothing found. Try another account."
Exit Sub
End If
' get the most recent email
myitems.Sort "ReceivedTime", True
Set myitem = myitems.GetFirst
If myitem.Class = olMail Then
' and now you can do whatever you want
MsgBox (myitem.Subject)
End If
End Sub