I've New Ticket folder, once replied from the New Ticket folder mails have to be moved to Completed folder.
Getting error message
This method can't be used in an inline response mail item.
at olMail.Move olDestFolder ' move to InProgress folder.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olNameSpace As Outlook.NameSpace
Set olNameSpace = GetNamespace("MAPI")
Dim olDestFolder As Outlook.Folder
Set olDestFolder = olNameSpace.Folders("xxx#xxx.com").Folders("In Progress")
Dim olLookUpFolder As Outlook.Folder
Set olLookUpFolder = olNameSpace.Folders("xxx#xxx.com").Folders("Tickets")
Dim olMail As Outlook.MailItem
For Each olMail In olLookUpFolder.Items 'loop through Tickets folder to find original mail
If InStr(1, olMail.Subject, strTicket) > 0 Then 'look for unique ticket Id
olMail.Move olDestFolder ' move to InProgress folder
Exit For
End If
Next
End Sub
From the comment "strTicket- to read the subject line and see if the particular subject line as a response".
You need strTicket = "text based on Item.Subject" for
If InStr(1, olMail.Subject, strTicket) > 0
For example:
Item.Subject "Re: Ticket #123456"
strTicket would be 123456.
If InStr(1, olMail.Subject, strTicket) > 0 Then 'look for unique ticket Id in olLookUpFolder.Items
There is no need to extract the unique ticket Id. olMail.Subject is unique and will be in Item.Subject.
If Item.Subject is "Re: Ticket #123456"
then olMail.Subject is "Ticket #123456"
Reverse the order of the search terms in InStr.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olNameSpace As NameSpace
Set olNameSpace = GetNamespace("MAPI")
Dim olDestFolder As folder
Set olDestFolder = olNameSpace.Folders("xxx#xxx.com").Folders("In Progress")
Dim olLookUpFolder As folder
Set olLookUpFolder = olNameSpace.Folders("xxx#xxx.com").Folders("Tickets")
' olMail is a Class. Avoid as a variable name
'Dim olMail As MailItem
Dim olObj As Object ' Outlook items are not necessarily mailitems
For Each olObj In olLookUpFolder.Items 'loop through Tickets folder to find original mail
If olObj.Class = olMail Then
If InStr(1, Item.Subject, olObj.Subject) > 0 Then 'look for olObj.Subject in Item.Subject
olObj.Move olDestFolder ' move to InProgress folder
Exit For
End If
End If
Next
End Sub
If the preview pane is on then
Error: "This method can't be used with an inline response mail item."
This code restarted Outlook and disabled VBA the first time. Subsequently it only restarted Outlook. If you get similar results you may decide to turn off the preview pane yourself so the preview pane check is not invoked.
If InStr(1, Item.Subject, olObj.Subject) > 0 Then 'look for olObj.Subject in Item.Subject
If ActiveExplorer.IsPaneVisible(olPreview) = True Then
' Hide Preview Pane
' https://learn.microsoft.com/en-us/office/vba/api/outlook.explorer.ispanevisible
ActiveExplorer.ShowPane olPreview, False
olObj.Move olDestFolder ' move to InProgress folder
' Show Preview Pane
ActiveExplorer.ShowPane olPreview, True
Else
olObj.Move olDestFolder ' move to InProgress folder
End If
Exit For
End If
More information about the error related to inline response.
Related
I'm trying to move emails from Inprogress Folder to Completed Folder, based on the word placed in the body of the mail when replied to.
if the reply mail has the word Completed then the reply mails have to be moved to Completed Folder.
if the reply mail has the word Cancelled then the reply mails have to be moved to Cancelled Folder.
I tried the below code, but it throws
Compile Error: Excepted expression
Error is because of this two-line.
If InStr(1,olMail.Body, "Completed") And
If InStr(1, Item.Subject, olObj.Subject) > 0
Full Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olNameSpace As NameSpace
Set olNameSpace = GetNamespace("MAPI")
Dim olDestFolder As folder
Set olDestFolder = olNameSpace.Folders("xxx#xxx.com").Folders("Completed")
Dim olLookUpFolder As folder
Set olLookUpFolder = olNameSpace.Folders("xxx#xxx.com").Folders("InProgress")
' olMail is a Class. Avoid as a variable name
'Dim olMail As MailItem
Dim olObj As Object ' Outlook items are not necessarily mailitems
For Each olObj In olLookUpFolder.Items 'loop through Tickets folder to find original mail
If olObj.Class = olMail Then
If InStr(1,olMail.Body, "Completed") And
If InStr(1, Item.Subject, olObj.Subject) > 0 Then 'look for olObj.Subject in Item.Subject
olObj.Move olDestFolder ' move to InProgress folder
Exit For
End If
End If
Next
End Sub
You wanted to write
If InStr(1,olMail.Body, "Completed") > 0 And InStr(1, Item.Subject, olObj.Subject) > 0 Then 'look for olObj.Subject in Item.Subject
olObj.Move olDestFolder ' move to InProgress folder
Exit For
End If
I'm trying to write a macro to move email if the attachment filename matches a string (for example, "asdfqwerty"). The email would move from my Inbox to the folder "Test" under my Inbox.
Using Redemption is not an option unfortunately.
Any help is appreciated!
Edit
Here is my updated code based on the tips from Dmitry. I am now getting a 'Type mismatch' error on the very last Next and am not sure why:
Sub SaveOlAttachments()
Dim olFolder As MAPIFolder
Dim olFolder2 As MAPIFolder
Dim msg As mailItem
Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olFolder2 = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Test")
For Each msg In olFolder.Items
If msg.Class = 43 Then
If msg.Attachments.Count > 0 Then
If Left$(msg.Attachments(1).FileName, 10) = "asdfqwerty" Then
msg.Move (oldFolder2)
End If
End If
End If
Next
End Sub
Did you try to run that code? It will error on the msg.Attachments > 0 line. You need msg.Attachments.Count > 0.
The next line also won't run - you need to loop through all attachments in the msg.Attachments collection:
for each attach in msg.Attachments
if InStr(attach.FileName, "asdfqwerty") Then
msg.Move (olFolder2)
Exit for
End If
next
Before posting, please at least try to apply some effort to make sure your code compiles and maybe even runs. Do not expect other people to do that for you.
The email with the attachment comes in and a Rule executes the following VBA script:
Sub Test()
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myFin As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
'Ask for destination folder
myOrt = "W:\"
On Error Resume Next
'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'for all items do...
For Each myItem In myOlSel
'point on attachments
Set myAttachments = myItem.Attachments
'if there are some...
If myAttachments.Count > 0 Then
'for all attachments do...
For i = 1 To myAttachments.Count
'Ask for destination folder
myFin = InputBox("Please type a filename below:", "Saving
recording...", "")
'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myFin
Next i
End If
Next
End Sub
I created a rule, that starts a VBA-script depending on the subject of a received email (Rule: Subject "MY_SUBJECT" -> start script).
The VBA script is then doing some stuff and then it should finally delete the original email.
This part is easy:
Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
' doSomething:
' delete email from inbox
Item.Delete
End Sub
Now the email will sit in the deleted-items-folder. But what I need to achieve is, to also delete this mail from the deleted-items folder. Since I know the subject of this mail (because this triggered my rule in the first place), I tried the following approach:
Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
' doSomething:
' delete email from inbox
Item.Delete
End Sub
' delete email from deleted items-folder
Dim deletedFolder As Outlook.Folder
Set deletedFolder = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems)
Dim i As Long
For i = myFolder.Items.Count To 1 Step -1
If (deletedFolder.Items(i).Subject) = "MY_SUBJECT" Then
deletedFolder.Items(i).Delete
Exit For
End If
Next if
End Sub
Well, this basically works: The mail with this subject will be found in the deleted-items-folder and it will be deleted, yes.
But sadly it does not work as expected:
This permanent deletion only works once I start the script a second time.
So the email which is triggering my script will never be deleted permanently in this script's actual run, but only in the next run (once the next email with the trigger-subject for my rule is received - but then this very next email won't be deleted, again).
Do you have any idea what I am doing wrong here? It somehow looks like I need to refresh my deleted-items folder somehow. Or do I have to comit my first Item.Delete somehow explicitly?
The problem was not recreated, but try stepping through this then run normally if it appears to do what you want.
Sub doWorkAndDeleteMail(Item As mailitem)
Dim currFolder As Folder
Dim DeletedFolder As Folder
Dim i As Long
Dim mySubject As String
Set currFolder = ActiveExplorer.CurrentFolder
mySubject = Item.Subject
Debug.Print mySubject
Set DeletedFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
Set ActiveExplorer.CurrentFolder = DeletedFolder
Debug.Print "DeletedFolder.count before delete: " & DeletedFolder.Items.count
' delete email from deleted items-folder
Item.Delete
Debug.Print "DeletedFolder.count after delete: " & DeletedFolder.Items.count
' If necessary
'DoEvents
For i = DeletedFolder.Items.count To 1 Step -1
Debug.Print DeletedFolder.Items(i).Subject
If (DeletedFolder.Items(i).Subject) = mySubject Then
Debug.Print DeletedFolder.Items(i).Subject & " *** found ***"
DeletedFolder.Items(i).Delete
Exit For
End If
Next
Set ActiveExplorer.CurrentFolder = currFolder
End Sub
Tim Williams suggested another existing thread. I had a look at that already before and decided that appoach would be exactly the same representation of my bug. I did try it out, though (to show my motiviation :) ), but the behaviour is - as expected - exactly the same: Again the final deletion only works once the next time the script is triggered via rule:
Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
' First set a property to find it again later
Item.UserProperties.Add "Deleted", olText
Item.Save
Item.Delete
'Now go through the deleted folder, search for the property and delete item
Dim objDeletedFolder As Outlook.Folder
Dim objItem As Object
Dim objProperty As Variant
Set objDeletedFolder = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderDeletedItems)
For Each objItem In objDeletedFolder.Items
Set objProperty = objItem.UserProperties.Find("Deleted")
If TypeName(objProperty) <> "Nothing" Then
objItem.Delete
End If
Next
End Sub
I would be really glad to get some help here. I also wanted to comment on that other thread, but my reputation is not enough, yet.
Try something like this, code goes under ThisOutlookSession
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim DeletedFolder As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems)
Set Items = DeletedFolder.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
Dim olNs As Outlook.NameSpace
Dim DeletedFolder As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Filter As String
Dim i As Long
Set olNs = Application.GetNamespace("MAPI")
Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems)
Filter = "[Subject] = 'MY_SUBJECT'"
Set Items = DeletedFolder.Items.Restrict(Filter)
If TypeOf Item Is Outlook.MailItem Then
For i = Items.Count To 1 Step -1
DoEvents
Items.Remove i
Next
End If
End Sub
Edit
Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
' First set a property to find it again later
Item.UserProperties.Add "Deleted", olText
Item.Save
Item.Delete
'Now go through the deleted folder, search for the property and delete item
Dim olNs As Outlook.NameSpace
Dim DeletedFolder As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Filter As String
Dim i As Long
Set olNs = Application.GetNamespace("MAPI")
Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems)
Filter = "[Subject] = 'MY_SUBJECT'"
Set Items = DeletedFolder.Items.Restrict(Filter)
If TypeOf Item Is Outlook.MailItem Then
For i = Items.Count To 1 Step -1
DoEvents
Items.Remove i
Next
End If
End Sub
the Mailbox folder that you get can be used as a collection, meaning that you can remove the item directly, you will need the collection to be sent to the function but that should be managable :)
Sub doWorkAndDeleteMail(Mailbox As Outlook.Folder, Item As Outlook.MailItem)
' doSomething:
' delete email from inbox
For Ite = 1 To Mailbox.Items.Count
If Mailbox.Items(Ite).EntryID = Item.EntryID Then
Mailbox.Items.Remove Ite
Exit For
End If
Next
End Sub
Remember that IF you want to Delete more than 1 Item per call of "For Ite = 1 To Mailbox.Items.Count", you will need to subtract 1 from the check of the item within the For segment since when you remove a mail from it, it will reduce the rest of the mails index number by 1.
Hope you can still use this :)
Regards Sir Rolin
In Outlook, if I activate "always move messages in this conversation", it will:
Move all of the messages in the conversation to the target folder, including those in Sent Items
From that moment on, all messages received in that conversation will be moved to the target folder. However, all messages sent in that conversation will remain in the Sent Items folder.
I want step 1 to exclude those already in sent items.
Background: we're using a shared mailbox, and I can't have a quick step for each of us because there will be too many of them.
So I made a sub with a button that takes the username and moves (enables always move) to the corresponding folder.
But, I want the sent items to remain - is this possible, or should I make my own "alwaysMoveMessages" function?
Thank you!
Work with Conversation.GetRootItems A SimpleItems collection that includes the root item or all root items of the conversation and Conversation.GetTable A Table object that contains all Items in the conversation.
Example Code
Option Explicit
Sub MoveConv()
Dim olNs As NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim SelectedItem As Object
Dim Item As Outlook.MailItem ' Mail Item
Dim Folder As Outlook.MAPIFolder ' Current Item's Folder
Dim Conversation As Outlook.Conversation ' Get the conversation
Dim ItemsTable As Outlook.Table ' Conversation table object
Dim MailItem As Object
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
' On Error GoTo MsgErr
' // Must Selected Item.
Set SelectedItem = Application.ActiveExplorer.Selection.Item(1)
' // If Item = a MailItem.
If TypeOf SelectedItem Is Outlook.MailItem Then
Set Item = SelectedItem
Set Conversation = Item.GetConversation
If Not IsNull(Conversation) Then
Set ItemsTable = Conversation.GetTable
For Each MailItem In Conversation.GetRootItems ' Items in the conv.
If TypeOf MailItem Is Outlook.MailItem Then
Set Item = MailItem
Set Folder = Item.Parent
Set SubFolder = Inbox.Folders("Temp") ' Move to Temp Folder
Debug.Print Item.ConversationID & " In Folder " & Folder.Name
GetConv Item, Conversation
Item.Move SubFolder
End If
Next
End If
End If
MsgErr_Exit:
Set olNs = Nothing
Set Inbox = Nothing
Set Item = Nothing
Set SelectedItem = Nothing
Set MailItem = Nothing
Exit Sub
'// Error information
MsgErr:
MsgBox "Err." _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume MsgErr_Exit
End Sub
Function GetConv(Item As Object, Conversation As Outlook.Conversation)
Dim Items As Outlook.SimpleItems
Dim MailItem As Object
Dim Folder As Outlook.Folder
Dim olNs As NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Set Items = Conversation.GetChildren(Item)
If Items.Count > 0 Then
For Each MailItem In Items
If TypeOf MailItem Is Outlook.MailItem Then
Set Item = MailItem
Set Folder = Item.Parent
Set SubFolder = Inbox.Folders("Temp")
Debug.Print Item.ConversationID & " In Folder " & Folder.Name
Item.Move SubFolder
End If
GetConv Item, Conversation
Next
End If
End Function
This question already has answers here:
For Each loop: Some items get skipped when looping through Outlook mailbox to delete items
(2 answers)
Closed 7 years ago.
I seem to be getting issues with moving emails from inbox to a sub-folder of inbox. I always thought my code was working until today. I noticed it's only moving half of the emails. I do not need a "move all" code, I have a purpose for this but I just need to move each emails and not all at once (I needed to check each emails). Please take a look at my code below. myNamespace.Folders.Item(1).Folders.Item(2) is my main Inbox.
Sub MoveEachInboxItems()
Dim myNamespace As Outlook.NameSpace
Set myNamespace = Application.GetNamespace("MAPI")
For Each Item In myNamespace.Folders.Item(1).Folders.Item(2).Items
Dim oMail As Outlook.MailItem: Set oMail = Item
Item.UnRead = True
Item.move myNamespace.Folders.Item(1).Folders.Item(2).Folders("Other Emails")
Next
End Sub
here is good link
Moves Outlook Mail items to a Sub folder by Email address
Option Explicit
Public Sub Move_Items()
' // Declare your Variables
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim olNs As Outlook.NameSpace
Dim Item As Object
Dim Items As Outlook.Items
Dim lngCount As Long
On Error GoTo MsgErr
' Set Inbox Reference
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items
' // Loop through the Items in the folder backwards
For lngCount = Items.Count To 1 Step -1
Set Item = Items(lngCount)
If Item.Class = olMail Then
Select Case Item.SenderEmailAddress
' // Email_One
Case "Email_One#email.com"
' // Set SubFolder of Inbox
Set SubFolder = Inbox.Folders("Folder One")
Set Item = Items.Find("[SenderEmailAddress] = 'Email_One#email.com'")
If TypeName(Item) <> "Nothing" Then
' // Mark As Read
Item.UnRead = False
' // Move Mail Item to sub Folder
Item.Move SubFolder
End If
' // Email_Two
Case "Email_Two#email.com"
' // Set SubFolder of Inbox
Set SubFolder = Inbox.Folders("Folder Two")
Set Item = Items.Find("[SenderEmailAddress] = 'Email_Two#email.com'")
If TypeName(Item) <> "Nothing" Then
' // Mark As Read
Item.UnRead = False
' // Move Mail Item to sub Folder
Item.Move SubFolder
End If
End Select
End If
Next lngCount
MsgErr_Exit:
Set Inbox = Nothing
Set SubFolder = Nothing
Set olNs = Nothing
Set Item = Nothing
Set Items = Nothing
Exit Sub
'// Error information
MsgErr:
MsgBox "An unexpected Error has occurred." _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume MsgErr_Exit
End Sub
Or to move all Mail items Inbox to sub folder
Option Explicit
Public Sub Move_Items()
' // Declare your Variables
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim olNs As Outlook.NameSpace
Dim Item As Object
Dim lngCount As Long
Dim Items As Outlook.Items
On Error GoTo MsgErr
' Set Inbox Reference
Set olNs = Application.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Set Items = Inbox.Items
' // Loop through the Items in the folder backwards
For lngCount = Items.Count To 1 Step -1
Set Item = Items(lngCount)
Debug.Print Item.Subject
If Item.Class = olMail Then
' // Set SubFolder of Inbox
Set SubFolder = Inbox.Folders("Temp")
' // Mark As Read
Item.UnRead = False
' // Move Mail Item to sub Folder
Item.Move SubFolder
End If
Next lngCount
MsgErr_Exit:
Set Inbox = Nothing
Set SubFolder = Nothing
Set olNs = Nothing
Set Item = Nothing
Exit Sub
'// Error information
MsgErr:
MsgBox "An unexpected Error has occurred." _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume MsgErr_Exit
End Sub