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
Related
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
I hope there is someone who have an idea about this issue.
I want to archive a sender's emails(for example send form : test#tect.com) to more than one folder in outlook concurrently by using automatic rule function.
Is this possible?
Yes it is possible with help of script rule and vba code.
the following code creates a copy of the identified message as it arrives and then moves the copy message to multiple to folders.
Option Explicit
Public Sub MoveItems(olItem As Outlook.MailItem)
Dim olApp As New Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim olDestFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim CopyItem As Object
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olInbox = olNameSpace.GetDefaultFolder(olFolderInbox)
Set olItems = olInbox.Items
'// loop
While TypeName(olItem) <> "Nothing"
Set olDestFolder = olInbox.Folders("TEMP1") 'Folder
Set CopyItem = olItem.copy
olItem.Move olDestFolder
Set olDestFolder = olInbox.Folders("TEMP2") 'Folder
olItem.Move olDestFolder
Set olDestFolder = olInbox.Folders("TEMP3") 'Folder
olItem.Move olDestFolder
'// Add more folders here
Set olItem = olItems.FindNext
Wend
Set olNameSpace = Nothing
Set olInbox = Nothing
Set olDestFolder = Nothing
Set olItems = Nothing
Set olItem = Nothing
Set CopyItem = Nothing
End Sub
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 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
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