I've tried countless ways of deleting items from a custom folder called "Spam Digests" older than 14 days. I have successfully done this when I nest this folder underneath the olDefaultFolder(Inbox) but when I have it outside of the default inbox, I cannot reference it as I receive object not found.
Here is what I have and I cannot seem to figure out why the object is not found when referencing "fldSpamDigest"
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
Set fldSpamDigest = outapp.GetNamespace("MAPI").Folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If DateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
GetDefaultFolder(olFolderInbox) is a shortcut.
You can reference any folder the long way.
Sub reference_walk_the_path()
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
Dim olitem As Object
Dim fldSpamDigest As Outlook.MAPIFolder
' from the default inbox to the parent which is your mailbox
Set fldSpamDigest = outapp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent
' from the mailbox to a folder at the same level as the Inbox
Set fldSpamDigest = fldSpamDigest.folders("Spam Digests")
' or
' directly from the mailbox to a folder at the same level as the Inbox
'Set fldSpamDigest = outapp.GetNamespace("MAPI").folders("your email address").folders("Spam Digests")
For Each olitem In fldSpamDigest.Items
If dateDiff("d", olitem.CreationTime, Now) > 14 Then olitem.Delete
Next
Set fldSpamDigest = Nothing
Set olitem = Nothing
Set outapp = Nothing
End Sub
Dim outapp As Outlook.Application
Set outapp = CreateObject("outlook.application")
There is no need to create a new Outlook Application instance in the Outlook VBA, simply use the Application property
To reference a folder that is not under default Inbox - example would be
Option Explicit
Public Sub Example()
Dim olNs As Outlook.NameSpace
Set olNs = Application.Session
Dim Digest_Fldr As Outlook.MAPIFolder
Set Digest_Fldr = olNs.GetDefaultFolder(olFolderInbox) _
.Parent.Folders("fldSpamDigest")
Dim Items As Outlook.Items
Set Items = Digest_Fldr.Items
Dim i As Long
For i = Items.Count To 1 Step -1
DoEvents
Debug.Print Items(i).Subject
Next
End Sub
Related
I want a macro/rule/code that creates a folder in Outlook based on the sender's domain, after that I want it to create a folder based on the sender's name in the sender's domain folder, and then move the mail to that folder.
I am thinking of a folder layout like this:
Inbox\#senders domain\#Senders name\Email.msg
Please refer to this code, however, you may need to change something as your special request.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
' set object reference to default Inbox
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
' fires when new item added to default Inbox
' (per Application_Startup)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim targetFolder As Outlook.MAPIFolder
Dim senderName As String
' don't do anything for non-Mailitems
If TypeName(item) <> "MailItem" Then GoTo ProgramExit
Set Msg = item
' move received email to target folder based on sender name
senderName = Msg.senderName
If CheckForFolder(senderName) = False Then ' Folder doesn't exist
Set targetFolder = CreateSubFolder(senderName)
Else
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set targetFolder = _
objNS.GetDefaultFolder(olFolderInbox).Folders(senderName)
End If
Msg.Move targetFolder
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function CheckForFolder(strFolder As String) As Boolean
' looks for subfolder of specified folder, returns TRUE if folder exists.
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim FolderToCheck As Outlook.MAPIFolder
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
' try to set an object reference to specified folder
On Error Resume Next
Set FolderToCheck = olInbox.Folders(strFolder)
On Error Goto 0
If Not FolderTocheck Is Nothing Then
CheckForFolder = True
End If
ExitProc:
Set FolderToCheck = Nothing
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function
Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder
' assumes folder doesn't exist, so only call if calling sub knows that
' the folder doesn't exist; returns a folder object to calling sub
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
Set CreateSubFolder = olInbox.Folders.Add(strFolder)
ExitProc:
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function
More information, please see,
Create new folder for new sender name and move message into new folder
I am trying to move tasks from the To-Do list to an "Inquiries" Task folder.
Preferably it should move the task without having to select it.
This code gives me:
'Runtime Error '424' Object Required'
Original code from https://www.slipstick.com/outlook/macro-move-folder/
Sub MoveTask()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objItem As TaskItem
Dim strSignifier As String
Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderTasks)
Set objItem = objFolder.Items.Add(olTaskItem) ' this line has the error
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderTasks).Folders("Inquiries")
strSignifier = "#CT-"
If Left(Item.subject, Len(strSignifier)) = strSignifier Then
objItem.Move objDestFolder
End If
Set objDestFolder = Nothing
End Sub
You need to also Dim and Set objFolder in order to use it, or change it to objDestFolder or objSourceFolder depending on what you are trying to do.
Put Option Explicit at the top of your module and it will help detect these things.
I have an email account "Fred.Smith#domain.co.uk" (domain being made up).
Outlook shows an archive named " Archive - Fred.Smith#domain.co.uk" where Outlook automatically moves emails after a certain period.
Current code:
Set olRecip = olNS.CreateRecipient("Archive - Fred.Smith#domain.co.uk")
olRecip.Resolve
Set olFolder = olNS.GetSharedDefaultFolder(olRecip, olFolderInbox)
This opens the main inbox. How do I select the archive folder?
"Archive" folder is usually at the root level - like inbox
in that case:
Sub ArchiveItems()
' Moves each of the selected items on the screen to an Archive folder.
Dim olApp As New Outlook.Application
Dim olExp As Outlook.Explorer
Dim olSel As Outlook.Selection
Dim olNameSpace As Outlook.NameSpace
Dim olArchive As Outlook.Folder
Dim intItem As Integer
Set olExp = olApp.ActiveExplorer
Set olSel = olExp.Selection
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olArchive = olNameSpace.Folders("myMail#mail.com").Folders("Archive")
For intItem = 1 To olSel.Count
olSel.Item(intItem).Move olArchive
Next intItem
End Sub
to get Inbox you could use default access:
Dim olInbox As Outlook.Folder
Set olInbox = olNameSpace.GetDefaultFolder(olFolderInbox)
Note - This will get you the default Inbox folder, if you have a few accounts in outlook you should verify it's really the folder you want - or use the mail specific approach like in Archive folder above
For Debugging - if you want to check all available subfolders
For i = 1 To olInbox.Folders.Count
Debug.Print olInbox.Folders(i).Name
Next i
Should be
Dim ARCHIVE_FOLDER As Outlook.MAPIFolder
Set ARCHIVE_FOLDER = olNs.Folders("Archive - Fred.Smith#domain.co.uk")
Full Example
Option Explicit
Public Sub Example()
Dim olNs As Outlook.NameSpace
Dim ARCHIVE_FOLDER As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim i As Long
Set olNs = Application.Session
Dim ARCHIVE_FOLDER As Outlook.MAPIFolder
Set ARCHIVE_FOLDER = olNs.Folders("Archive - Fred.Smith#domain.co.uk") _
.Folders("Inbox")
Debug.Print ARCHIVE_FOLDER.Name
Debug.Print ARCHIVE_FOLDER.FolderPath
Debug.Print ARCHIVE_FOLDER.Store.DisplayName
ARCHIVE_FOLDER.Display
Set Items = ARCHIVE_FOLDER.Items
For i = Items.Count To 1 Step -1
DoEvents
Debug.Print Items(i).Subject
Next
End Sub
MAPIFolder Object
I am trying set a reference to a non-default inbox in MS Outlook. I have found a code in SO,
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("Procurement, Request")
Set objFolder = objFolder.Folders("Inbox")
which is OK when inbox is named "Inbox".
There is a possibility for inboxes to be named in non-English languages.
You may refer to the default inbox by
objNS.getdefaultfolder(6)
But what about non-defaults?
You should be able to get inboxes by Store index or name.
Option Explicit
Sub Inbox_by_Store()
Dim allStores As Stores
Dim storeInbox As Folder
Dim i As Long
Set allStores = Session.Stores
For i = 1 To allStores.count
Debug.Print i & " DisplayName - " & allStores(i).DisplayName
Set storeInbox = Nothing
On Error Resume Next
Set storeInbox = allStores(i).GetDefaultFolder(olFolderInbox)
On Error GoTo 0
If Not storeInbox Is Nothing Then
storeInbox.Display
End If
Next
ExitRoutine:
Set allStores = Nothing
Set storeInbox = Nothing
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