additem doesn't work in outllok 2010 even the application is trigerred. my outlook product is not activated. Is this matter ?
Public Sub myOlItems_ItemAdd(ByVal Item As Object)
Dim myForward As MailItem
MsgBox "item"
If TypeName(Item) = "MailItem" Then
First of all, make sure that you declared the source object with the WithEvents keywords like the following sample code shows:
Public WithEvents myOlItems As Outlook.Items
Public Sub Initialize_handler()
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
Dim myOlMItem As Outlook.MailItem
Dim myOlAtts As Outlook.Attachments
Set myOlMItem = myOlApp.CreateItem(olMailItem)
myOlMItem.Save
Set myOlAtts = myOlMItem.Attachments
' Add new contact to attachments in mail message
myOlAtts.Add Item, olByValue
myOlMItem.To = "Sales Team"
myOlMItem.Subject = "New contact"
myOlMItem.Send
End Sub
Also it makes sense to make sure the source object (in your case myOlItems) is initialized correctly.
Finally, you need to make sure VBA is allowed to run the code, i.e. VBA macros are not blocked in Outlook.
Related
Once I tab to the email's body I want to check the subject.
If equal to a specific text then open a template.
I wrote the part about the template.
The difficult part is using the inspectors to check the subject while writing the mail.
Code in thisOutlookSession
Private Sub subject()
Dim subject As String
Dim item As Outlook.MailItem
Dim inspector As Outlook.inspector
Dim template As Outlook.MailItem
Set inspector = Outlook.ActiveInspector
Set item = inspector.CurrentItem
subject = item.subject
Debug.Print subject
If subject = "test" Then
Set template = Application.CreateItemFromTemplate("C:test\test.oft")
Display.template
Else
End If
End Sub
Please, try the next way:
Create three variables on top of ThisOutlookSession:
Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector
Private WithEvents myItem As Outlook.MailItem
Copy the next Startup event code in ThisOutlookSession module:
Private Sub Application_Startup()
Set m_Inspectors = Application.Inspectors
End Sub
Or copy only the line Set m_Inspectors = Application.Inspectors inside it, if already used for other purposes.
Then, copy the next events code in the same module:
Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
If TypeOf Inspector.CurrentItem Is Outlook.MailItem Then
'Handle emails only:
Set m_Inspector = Inspector
End If
End Sub
Private Sub m_Inspector_Activate()
If TypeOf m_Inspector.CurrentItem Is MailItem Then
Set myItem = m_Inspector.CurrentItem '!!!
End If
End Sub
And the PropertyChange event to be triggered when pressing enter after writing the subject (or clicking somewhere else: body, To, CC etc.):
Private Sub myItem_PropertyChange(ByVal Name As String)
Const specSubject As String = "mySubject..." 'use here the subject you need to open the template!
Const templFullName As String = "C:test\test.oft"
If Name = "Subject" Then
If myItem.Subject = specSubject Then
'do whatever you need...
myItem.Close False 'probably you want closing the new Email. If not, comment this line...
With Application.CreateItemFromTemplate(templFullName)
.Display
End With
End If
End If
End Sub
Now, manually press New Email button and play with the new mail window Subject...
The MailItem exposes aPropertyChange(String Name) event, which fires when the email subject field looses focus (among other).
You can hookup to it, but you need to declare the mail item WithEvents at module level.
See an example below:
Private WithEvents m_item As MailItem
Sub T()
Set m_item = Application.CreateItem(olMailItem)
m_item.Display
End Sub
Private Sub m_item_PropertyChange(ByVal Name As String)
If Name = "Subject" Then Debug.Print m_item.Subject
End Sub
I'm looking to modify my VBA code to reference a shared inbox that has a subfolder inside of it. The commented out code worked with my main inbox folder and a sub folder called test. I've tried to use the getSharedDefaultfolder method but the code currently does not detect an email being placed in the subfolder of my shared inbox. Does anyone have any thoughts or recommendations?
Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Set olNs = Application.GetNamespace("MAPI")
Set shrdRecip = olNs.CreateRecipient(test#outlook.com)
Set Inbox = olNs.GetSharedDefaultFolder(shrdRecip, olFolderInbox).Folders("test")
'Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders("test")'
'Set objInboxItems = objInbox.Items'
Set objInboxItems = Inbox.Items
End Sub
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
MsgBox Item.Subject
If TypeOf Item Is MailItem Then
Set objMail = Item
MsgBox objMail.UnRead
If (objMail.UnRead Or False) Then
Set objForward = objMail.Forward
With objForward
.Subject = "Custom Subject"
.HTMLBody = "<HTML><BODY>Type body here. </BODY></HTML>" & objForward.HTMLBody
.Recipients.Add (usr#yahoo.com)
.Recipients.ResolveAll
.Send
MsgBox Item.Subject
End With
End If
End If
End Sub
Sub MyTEST()
End Sub```
You need to add the shared folder/store to your Outlook profile if you want to get events fired in VBA.
Also make sure an instance of the Items class was initialized correctly in the code to get the events fired.
I'd suggest calling the Recipient.Resolve method before accessing the shared folder, it attempts to resolve a Recipient object against the Address Book.
Are you sure objInboxItems is not null? By default, GetSharedDefaultFolder only returns the folder but not its subfolders unless the shared mailbox is added to the profile as a delegate mailbox and and all its folders are synchronized by Outlook.
In my Outlook addin a sub is run when an item is added to the sent mail folder. this item is then archived to a user defined folder (which is done when the mail items opens). In the code below it shows how I get the first items in the send item folder.
Public Sub mySentItems_ItemAdd() Handles mySentItems.ItemAdd
'variables
Dim AppOutlook As New Outlook.Application
Dim ns As Outlook.NameSpace = AppOutlook.Session
Dim siFolder As Outlook.Folder = CType(ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderSentMail), Outlook.Folder)
'load the newly added mail as mailitem
Dim mailitem As MailItem = siFolder.Items.GetFirst
MsgBox(mailitem.Subject.ToString)
End Sub
It worked fine a few weeks ago but now it doesnt get the first item in the folder, instead it gets the first item in the folder from the sub folder "Last week". In the image below the item I get is marked with yellow, the item I want is underlined with a black line. does anyone know how I can solve this problem?
Ok I figured it out, the last added item is not the first item in the list but the last item so instead of:
Dim mailitem As MailItem = siFolder.Items.GetFirst
I needed to use
Dim mailitem As MailItem = siFolder.Items.GetLast
First of all, there is no need to create a new Outlook Application instance:
Dim AppOutlook As New Outlook.Application
Instead, you should use the Application property of your add-in class.
Anyway, the Items.ItemAdd event provides an argument which represents an item added to the folder.
Public WithEvents myOlItems As Outlook.Items
Public Sub Initialize_handler()
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
Dim myOlMItem As Outlook.MailItem
Dim myOlAtts As Outlook.Attachments
Set myOlMItem = myOlApp.CreateItem(olMailItem)
myOlMItem.Save
Set myOlAtts = myOlMItem.Attachments
' Add new contact to attachments in mail message
myOlAtts.Add Item, olByValue
myOlMItem.To = "Sales Team"
myOlMItem.Subject = "New contact"
myOlMItem.Send
End Sub
I have multiple mailboxes set-up in my Outlook 2010. I would like a macro to run when I receive a mail on one of the non-default mailboxes.
I have coded the below and inserted the code into "ThisOutlookSession".
I have gotten it to work for the default mailbox's inbox but not my nondefault mailbox's inbox. When I try to re-open outlook 2010 having inserted the code, It tells me :
"Compile error in hidden module: ThisOutlookSession". The non-default box is called 'abc.asia'.
I am new to vba so any inputs are appreciated, thank you!
Dim WithEvents myInboxMailItem As Outlook Items
Private Sub myInboxMailItem_ItemAdd(ByVal Item As Object)
MsgBox("Item Added")
End Sub
Private Sub Initialize_Handler()
Dim fldInbox As Outlook.MapiFolder
Dim gnspNameSpace As Outlook.NameSpace
Set gnspNameSpace = Outlook.GetNameSpace("Mapi")
Set fldInbox = gnspNameSpace.Folders("abc.asia").Folders("Inbox")
Set myInboxMailtItem = fldInbox.Items
End Sub
Update Set olRecip = olNs.CreateRecipient("emal#address.com") with correct Email address.
Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim olRecip As Recipient
Set olNs = Application.GetNamespace("MAPI")
Set olRecip = olNs.CreateRecipient("emal#address.com") '// Owner's Name or email address
Set Inbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
Set Items = Inbox.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Debug.Print Item.Subject
End If
End Sub
I am trying to write a brief VBA script that will move incoming messages from my Outlook Inbox to a subfolder. This is what I currently have (assembled from various posts), but I'm not getting any result when I send test emails. If there are any other posts that would relate to this, I would appreciate it!
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
Set myInbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
If TypeName(item) = "MailItem" Then
Set Msg = item
If Msg.SenderEmailAddress = "name#example.com" Then
If InStr(0, Msg.Subject, "Subject Title", vbTextCompare) > 0 Then
Msg.Move myInbox.Folders("Test").Subfolder("Destination")
End If
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
It looks like you didn't define and initialize the Items object properly. For example:
Public WithEvents myOlItems As Outlook.Items
Public Sub Initialize_handler()
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
' do something here
End Sub
Be aware, the ItemAdd event is not fired when more than 16 items is added at the same time. This is a known issue in the OOM.
Try to use the NewMailEx event of the Application class instead. And I'd suggest reading the following series of articles:
Outlook NewMail event unleashed: the challenge (NewMail, NewMailEx, ItemAdd)
Outlook NewMail event: solution options
Outlook NewMail event and Extended MAPI: C# example
Outlook NewMail unleashed: writing a working solution (C# example)
Finally, is your macro enabled in Outlook? Have you checked out the Trust center settings?
Put your code in ThisOutlookSession.
Just above your code put
Public WithEvents Items As Items
When using the built-in class module ThisOutlookSession, Sub Application_Startup() initializes the handler.