I have a Sub that opens the Folder for the current open mail-item.
This makes sense if I have an item open, but have changed the mail-Folder inbetween, and want to open the right Folder straight away again.
Sub ordner_mail_oeffnen()
On Error GoTo exit_sub
'Dim olApp As Outlook.Application
Dim olitem As Outlook.mailitem
'Set olApp = Outlook.Application
Set olitem = Outlook.Application.ActiveInspector.CurrentItem
Dim olfolder As MAPIFolder
Dim FolderPath As String
Dim Subfolder As Outlook.MAPIFolder
FolderPath = GetPath(olitem)
Set olfolder = GetFolder(FolderPath)
olfolder.Display
'those two lines are just for test purpose
MsgBox "jetzt"
Application.ActiveExplorer.ClearSelection
Sleep (10000)
Application.ActiveExplorer.ClearSelection
'here comes the runtime-error (I try to translate) "-2147467259 (80004005) element can not be activated or deactivated, as id does not exist in the current view"
Application.ActiveExplorer.AddToSelection olitem
exit_sub:
exit_sub:
End Sub
Only after the error the new Folder is opened but does not select certain mail.
Use Explorer.ClearSelection and Explorer.AddToSelection to select an item.
The current Explorer is returned from Application.ActiveExplorer.
You could continue to use GetPath(olitem) and GetFolder(FolderPath) but since the code was not included I cannot be sure.
Replace olfolder.Display with Set ActiveExplorer = olfolder.
Without GetPath(olitem) and GetFolder(FolderPath).
Option Explicit
Sub ordner_mail_oeffnen()
Dim olitem As Object
Dim olfolder As Folder
Set olitem = ActiveInspector.CurrentItem
Set olfolder = olitem.Parent
Set ActiveExplorer = olfolder
ActiveExplorer.ClearSelection
ActiveExplorer.AddToSelection olitem
End Sub
I had the same issue and found out that Outlook must be given time to bring up the new Display. This can be done using DoEvents. For me, the following works:
Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub ordner_mail_oeffnen()
Dim olitem As Outlook.MailItem
Set olitem = Outlook.Application.ActiveInspector.CurrentItem
Dim olfolder As MAPIFolder
Set olfolder = olitem.Parent
olfolder.Display
'Sleep 10000 ' does not help
'MsgBox ("Interruption") ' does not help
DoEvents ' Important!
If Application.ActiveExplorer.IsItemSelectableInView(olitem) = False Then
Stop ' We should not get here!
' But we will, if the line <DoEvents> is missing.
End If
Application.ActiveExplorer.ClearSelection
Application.ActiveExplorer.AddToSelection olitem
End Sub
If you omit the DoEvents, the code will run into the Stop command. A previous Sleep or MsgBox will not help.
Caveat: when you debug the code step by step (F8), the initial problem will not show up.
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
I made a code that would take an incomming email in a specific folder (First a rule is created in order to move the mail to the folder and then the script is launched).
The problem is that the rule is working (it moves the mail to the folder), but the script isn't.
The thing is that when I take the new mail and transfer it to myself (My email is also in the receivers in the rules), the script is correctly working.
Here is the beginning of the code that I believe may be wrong.
Sub Script(item As Outlook.MailItem)
Dim strMailID As String
Dim objMail As Outlook.MailItem
Dim objNamespace As Outlook.NameSpace
strMailID = item.EntryID
Set objNamespace = Application.GetNamespace("MAPI")
Set objMail = objNamespace.GetItemFromID(strMailID)
Dim objpf As MAPIFolder
If objMail.MessageClass = "IPM.Note" Then
Any help would be appreciated
You need add an event listener to the default local Inbox, it worked with Outlook 2016.
This code will add an event listener to the default local Inbox. Action will be placed upon incoming emails. You need to add actions you need in the code below:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
After pasting the code in ThisOutlookSession module, you must restart Outlook.
My Outlook macro worked at one time, then stopped. When it parses, the macro throws an error "Compile Error: Variable not defined". It seems the macro does not recognize that that folder exists. I cut the code to the bare minimum and it is a repeatable problem. The macro will recognize standard folders such as JUNK and DRAFTS but not PROCESSED_FOLDERS. I have tried renaming Processed_Folders as well as creating a new folder with a different name. No joy.
Folder structure is:
reports#xxx.com
Inbox
Drafts
Sent
Trash
Junk
Processed_Reports
Outbox
Sync Issues1 (This computer only)
SearchFolders
CODE:
Sub testfforfolder()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
On Error GoTo xyz
Set olFolder = olFolder.Folders("Processed_Reports")
MsgBox "Folder Exists" ' This line works if I use DRAFTS or JUNK
Exit Sub
xyz:
MsgBox ("Cannot find Folder") ' I get here if I use PROCESSED_REPORTS
Exit Sub
End Sub
Thanks to the comment by Tony Dallimore I was able to solve the issue. The link to https://stackoverflow.com/a/12146315/973283 let me solve the problem. With an updated version of Outlook, the default email account was being referenced rather than the account of the selected item. The Processed_Reports folder only existed in a different account folder. The solution, as Tony suggested, was to set the target folder to the full path to the target. I did need one more level as shown in the working solution below.
Sub testfforfolder()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
On Error GoTo xyz
'OLD INCORRECT
'Set olFolder = olFolder.Folders("Processed_Reports")
'WORKING CORRECTION
Set TgtFolder= _
Session.Folders("reports#xxx.com"). _
Folders("Inbox").Folders("Processed_Reports")
MsgBox "Folder Exists" ' This line works if I use DRAFTS or JUNK
Exit Sub
xyz:
MsgBox ("Cannot find Folder") ' I get here if I use PROCESSED_REPORTS
Exit Sub
End Sub
here is a way to get the session folder without knowing the session name
Sub topFolder()
Dim topFolder As Folder
Set topFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent
Dim i As Integer
For i = 1 To topFolder.Folders.Count
Debug.Print topFolder.Folders(i).Name
Next i
For i = 1 To topFolder.Folders("inbox").Folders.Count
Debug.Print topFolder.Folders("inbox").Folders(i).Name
Next i
End Sub
Is it possible to run a macro on an email that I manually select in my inbox. For instance, right click on the email and select "Send to >> Macro >> (show list of subroutines accepting Outlook.MailItem as a parameter)?
I think you will have to add a Button to the mail-ribbon. This Button can call an Routine.
In this Routine you use the active selection:
Sub example()
Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Dim olExplorer As Explorer
Dim olfolder As MAPIFolder
Dim olSelection As Selection
Dim olitem As mailitem
Set olExplorer = Application.ActiveExplorer
Set olfolder = Application.ActiveExplorer.CurrentFolder
If olfolder.DefaultItemType = olMailItem Then
Set olSelection = olExplorer.Selection
end if
For Each olitem In olSelection
'do something
Next olitem
end sub
I hope you get this working...
Max
So, I was able to simplify Max's answer a bit, but he certainly pointed me in the right direction. Below is basically what I'm going with. After selecting an email in my inbox, I should be able to run this macro and proceed to work on it.
Sub example()
Dim x, mailItem As Outlook.mailItem
For Each x In Application.ActiveExplorer.Selection
If TypeName(x) = "MailItem" Then
Set mailItem = x
call fooMail(mailItem)
End If
Next
End Sub
Sub fooMail(ByRef mItem as Outlook.MailItem)
Debug.print mItem.Subject
End Sub
I sometimes get emails that I want to keep but to move them into the appropriate folder can be a pain. How can I execute a script that will move (like using C-S-v) the email I'm looking at into a certain folder called "buffer", for instance?
I'm using Outlook 2007.
thanks.
EDIT:
there isn't any criteria that can be created to automate this process like through a rule. it is merely a judgment call I make as i'm staring at it.
This code may work better.
In your code, objFolder may be equal to Nothing, yet you continue the procedure. Also, the For Each loop assumes that each item is a mail item.
Sub MoveSelectedMessagesToFolder()
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim obj As Object
Dim msg As Outlook.mailItem
Set objNS = Application.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = objNS.Folders.item("Personal Folders").Folders.item("Buffer")
On Error GoTo 0
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
Exit Sub
End If
For Each obj In ActiveExplorer.Selection
If TypeName(obj) = "MailItem" Then
Set msg = obj
msg.Move objFolder
End If
Next obj
End Sub
Here's the code I'm using.
Sub MoveSelectedMessagesToFolder()
'Originally written by Chewy Chong
'Taken from http://verychewy.com/archive/2006/04/12/outlook-macro-to-move-an-email-to-folder.aspx
'Thanks Chewy!
'Ken
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
'For the "Item" portion, I used the name of the folder exactly as it appear in the ToolTip when I hover over it.
Set objFolder = objNS.Folders.Item("Personal Folders").Folders.Item("Buffer")
'Assume this is a mail folder
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next
Tools -> Rules & Alerts
Then Create a new rule telling all mail that fit whatever criteria to be deleted/marked as read/moved to a folder/any combination of those.
Edit:
If you don't want a rule/can't make a rule that fits, you can create a Macro (Tools -> Macro) to move it to a folder, then bind it to a shortcut.