We're trying to access the Sent Items folder in Outlook 2007 (using Exchange) but the test for TypeOf(i) Is Outlook.MailItem in the below code snippet always returns False.
We know we have the right folder because a test for items.Count returns the correct number of mail items.
Inbox messages are fine. If we change the folder from olFolderSentMail to olFolderInbox the test for TypeOf(i) Is Outlook.MailItem passes and it's quite happy to show us the Subject.
Dim app As Outlook.Application = Nothing
Dim ns As Outlook.NameSpace = Nothing
Dim siFolder As Outlook.Folder = Nothing
Dim items As Outlook.Items = Nothing
app = New Outlook.Application()
ns = app.Session
siFolder = CType(ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderSentMail), Outlook.Folder)
items = siFolder.Items
MsgBox(items.Count)
For Each i In items
If TypeOf (i) Is Outlook.MailItem Then
Dim mailitem As Outlook.MailItem
mailitem = CType(i, Outlook.MailItem)
MsgBox(mailitem.Subject)
Else
MsgBox("not a mailitem")
End If
Next
Update
#Rob's answer below, yes, definitely has helped. But I'm still puzzled. The crucial thing #Rob's code is doing is testing for .MessageClass = "IPM.Note". If I include that then the later test for TypeOf x Is MailItem succeeds. If I replace #Rob's test for .MessageClass = "IPM.Note" with If True Then then the same code still executes but the later test for Is MailItem fails. It's as if just testing for the .MessageClass automagically resolves the object into a MailItem.
Furthermore the Sent Items don't contain any meeting requests so the test would seem to be unnecessary anyway.
This should get you going ...
....
Dim oSent As Outlook.MAPIFolder = oNS.GetFolderFromID(gSentEntryID, gSentStoreID)
Dim oItems As Outlook.Items = oSent.Items
For i as Integer = 1 To oItems.Count
'Test to make sure item is a mail item and not a meeting request.
If oItems.Item(i).MessageClass = "IPM.Note" Then
If TypeOf oItems.Item(i) Is Microsoft.Office.Interop.Outlook.MailItem Then
.....
Related
I have written a macro which should move my email conversation to my "TO DO" folder whenever I flag the email as important. I find that the move function does happen, but I get a copy (i.e. the thread shows in both my "TODO"folder and still remains in the "Inbox".
What is also interesting is that in this line of code "For Each MailItem In Conversation.GetRootItems" I would have expected since all the messages do get moved that MailItem>1, but in fact that bit of code only executes one time and then the loop completes. Any thoughts on how to do a true move as opposed to be what appears to be a copy?
''''
Public WithEvents GExplorer As Outlook.Explorer
Public WithEvents GMailItem As Outlook.MailItem
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Set GExplorer = Outlook.Application.ActiveExplorer 'IGNORE THIS'
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Set olNameSpace = Application.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox)
Set Items = olFolder.Items
End Sub
Private Sub Items_ItemChange(ByVal Item As Object)
'this item/macro is used to move an email message once it has been flagged
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olInbox As Outlook.MAPIFolder
Set olNameSpace = Application.GetNamespace("MAPI")
Set olFolder = olNameSpace.Folders("DEBUG").Folders("TODO")
Stop 'THIS WAS FOR DEBUGGING
If TypeOf Item Is Outlook.MailItem And Item.FlagStatus = olFlagMarked Then
Set Conversation = Item.GetConversation
If Not IsNull(Conversation) Then
' Set ItemsTable = conversation.GetTable
'MsgBox Conversation.GetRootItems.Count
For Each MailItem In Conversation.GetRootItems ' Items in the conversation. ONLY RUNS ONCE'
If TypeOf MailItem Is Outlook.MailItem Then
Item.Move olFolder
End If
Next
End If
End If
End Sub
''''
That is because the same action (move) is repeated for the item changed and passed as a parameter to the ItemChange event handler. Instead, you must run the Move method against the item object in the loop:
For Each MailItem In Conversation.GetRootItems ' Items in the conversation. ONLY RUNS ONCE'
If TypeOf MailItem Is Outlook.MailItem Then
MailItem.Move olFolder
End If
Next
In addition to Eugene's suggestion (use MailItem instead of item when calling Move), you should never use "for each" with Outlook objects in loops that modify the collection you are iterating over - use a down loop from Count to 1 step -1.
Maybe you need to GetChildren of the conversation.
I have a code that loops through all sent MS Outlook emails and does some procedures on each one of them. My code breaks but if there is a calendar entry in my Sent folder which results in an error.
Run-time error '13': Type mismatch.
Do you guys know how to identify if an item in my Sent folder is a calendar entry so I can skip it?.
sub test()
Dim oApp As Outlook.Application
Set oApp = CreateObject("Outlook.application")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
Dim email_cnt As Long: email_cnt = olFolder.Items.Count
for t = 1 to email_cnt
Dim oMail As Outlook.MailItem
Set oMail = olFolder.Items.Item(t)
'do something;
Next t
End Sub
Check that oMail.Class = 43 (43 is olMailItem). You also need to avoid looping through all items in a folder (why do you need to do that?) and avoid using multiple dot notation (olFolder.Items.Item) - cache the Items collection in a variable before entering the loop.
How do I automatically send out multiple (currently visible) draft items with VBA?
Please help, thank you.
Edit: It's a tough case, none of the items are in the drafts folder yet. These are generated emails that are on your screen, waiting to be sent.
Edit2: nvm, it's not going to help anyway. My script creates approximately 500 emails, and displaying the first 100 causes out of memory error. I opted to auto send them without displaying (it breaks the layout this way, but it's my only option for now.)
It just so happens that I ran into the same issue before and have code handy. If you're not already in Outlook, you will need to add a reference in the VBA IDE, Tools ---> References... and check the box next to "Microsoft Outlook 14.0 Object Library".
Dim oFolder As Folder
Dim oNS As NameSpace
Dim olMail As MailItem
If (MsgBox("Are you sure you want to send ALL EMAILS IN YOUR DRAFTS FOLDER?", vbYesNo + vbCritical, "WARNING: THIS WILL SEND ALL DRAFTS")) = vbYes Then
Set oNS = Outlook.Application.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderDrafts)
For i = 1 To oFolder.Items.Count
oFolder.Items(1).Send
Next
End If
Set oNS = Nothing
Here's some code. Replace Your Name in myFolders("Mailbox - Your Name") with your actual name as it appears in the mailbox.
Public Sub EmailOutlookDraftsMessages()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Send all items in the "Drafts" folder that have a "To" address filled in.
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder.
Set myDraftsFolder = myFolders("Mailbox - Your Name").Folders("Drafts")
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
Source Code adapted from this Question's answer.
Thanks to the excellent assistance given on this site I found the code below - which works perfectly. I cannot (embarrassingly enough) figure out how to loop through the entire Inbox to move all emails (rather than selection as the code below does).
Any assistance most gratefully appreciated it.
John
Sub MoveWithRecDate()
' Moves selected emails with correct dates maintained
Dim objNS As Outlook.NameSpace
Dim Session As Redemption.RDOSession
Dim objRDOFolder As Redemption.RDOFolder
Dim objItem As Outlook.MailItem
Dim objRDOMail As Redemption.RDOMail
Set objNS = Application.GetNamespace("MAPI")
Set Session = CreateObject("Redemption.RDOSession")
Session.Logon
Set inbox = Session.GetDefaultFolder(olFolderInbox)
Set objRDOFolder = inbox.Parent.Folders("Cabinet")
For Each objItem In Application.ActiveExplorer.Selection
Set objRDOMail = Session.GetMessageFromID(objItem.EntryID)
objRDOMail.Move objRDOFolder
Next
End Sub
I had not heard of Redemption before reading your question. It looks very interesting so thank you for the information; I will try it next time I need to write a new Outlook macro.
I assume from the lack of an answer to your question that few others use Redemption either.
The Redemption website implies that the structure of Redemption code will be almost identical to standard Outlook code. I can only recall once writing a macro which operated on user selected items but my recollection is that the code looked like yours. The code below is standard Outlook but I hope that is enough for you to create the equivalent Redemption code.
You macro has the comment ' Moves selected emails with correct dates maintained. This implies you think there is a method by which emails can be moved so that dates are not maintained. I do not know such a method.
The code below examines every item in the Inbox. I did not want to move everything out of my Inbox so I have skipped items that are not mail items and are not from a specific sender.
I hope this is enough to get you going.
Sub MoveWithRecDate()
Dim FolderDest As MAPIFolder
Dim ItemToBeMoved As Boolean
Dim ItemCrnt As Object
Dim FolderSrc As MAPIFolder
Set FolderSrc = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set FolderDest = FolderSrc.Parent.Folders("Cabinet")
For Each ItemCrnt In FolderSrc.Items
ItemToBeMoved = True ' Assume item to be moved until discover otherwise
With ItemCrnt
If .Class = olMail Then
If .SenderEmailAddress <> "noreply#which.co.uk" Then
' Mail item not from Which
ItemToBeMoved = False
End If
Else
' Not mail item so do not move
ItemToBeMoved = False
End If
If ItemToBeMoved Then
.Move FolderDest
End If
End With
Next
End Sub
Outlook wont let me send multiple drafts at the same time. Is there an easy way to send multiple drafts at once in outlook? without having to open each one individually?
From what i've read, seen and tried; this is not possible from within outlook itself, and thus a programming solution would be required, probably some VB script
ok, i found a bit of VB that does it:
`Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Send all items in the "Drafts" folder that have a "To" address filled
'in.
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder. This will need modification based on where it's
'being run.
Set myDraftsFolder = myFolders("$MAILBOX").Folders("$DRAFTS")
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
just replace $MAILBOX with your mailbox name and $DRAFTS with the name of your drafts folder.
This has been personnaly tested and seems to work fine.
Not very different from author's answer, but still:
Sub SendDrafts()
Dim ns As NameSpace
Dim drafts As MAPIFolder
Dim Item As MailItem
Set ns = Application.GetNamespace("MAPI")
Set drafts = ns.GetDefaultFolder(olFolderDrafts) ' 16
For Each Item In drafts.Items
'Item.Send
Next
End Sub
Please be careful as it really sends all emails in your default draft folder. After uncommenting the send line. Dim lines to allow for autocompletion when inside Outlook macro editor.
A useful version, which I just tested in Outlook 2000:
Drag the emails you wish to send to the Outbox. They won't be sent automatically, but using this version of the prior posting sends them:
Sub SendOutbox()
Dim ns As NameSpace
Dim outbox As MAPIFolder
Dim Item As MailItem
Set ns = Application.GetNamespace("MAPI")
Set outbox = ns.GetDefaultFolder(olFolderOutbox) ' 16
For Each Item In outbox.Items
Item.Send
Next
End Sub
That way, you can be selective.
Yes, you can write a macro or add-in to do that.