Im stuck with problem to move active email to subfolder in inbox.
Need to replace ("xxxx#xxx.xxx") to something as olFolderInbox or inbox, etc without type specific email adress in VBA code.
Dim objMail As Outlook.MailItem
Dim objNS As Outlook.NameSpace
Dim objFolderItem As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")
Set objFolderItem = objNS.Folders.Item("xxxx#xxx.xxx").Folders.Item("tmp")
objMail.Move objMoveItem
Try this
Option Explicit
Public Sub Exampls()
Dim olNs As Outlook.NameSpace
Set olNs = Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Dim Item As MailItem
Set Item = ActiveExplorer.selection(1)
Item.Move Inbox.Folders("Temp")
End Sub
Related
I am having an issue with accessing a subfolder from a shared Outlook email box using VBA. The goal of this code is to download attachments from emails located in a subfolder called "Example_Subfolder". The code below results in an error message; "Run-time error '-2147221233 (8004010f)': The attempted operation failed. An object could not be found.".
Sub foo()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim destFolder As Outlook.MAPIFolder
Dim srcFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim subFolder As Object
Dim mailitem As Outlook.mailitem
Dim olAtt As Outlook.Attachment
Dim objOwner As Outlook.Recipient
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
'set object to shared email inbox
Set objOwner = olNS.CreateRecipient("Shared_Mailbox#companyname.com")
objOwner.Resolve
'check object resolved
If Not objOwner.Resolved Then
Debug.Print objOwner.Name
MsgBox "Failed to connect to shared email. Contact XXX."
End If
Set olFolder = olNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
'error on next line.
Set subFolder = olFolder.Folders("Example_Subfolder")
'download email attachments
'etc
'etc
End Sub
The only way I've been able to access the emails inside "Example_Subfolder" is by using Set subFolder = olNS.PickFolder. I would rather not use this method in my macro. Can anyone point me in the right direction as to why my code doesn't work?
Given the folder is visible in the navigation pane there is an alternative.
Sub foo()
Dim olNS As namespace
Dim olMailbox As Folder
Dim olInbox As Folder
Dim subFolder As Folder
Set olNS = GetNamespace("MAPI")
' If the folder is in the navigation pane
Set olMailbox = olNS.Folders("Shared_Mailbox#companyname.com")
Set olInbox = olMailbox.Folders("Inbox")
Set subFolder = olInbox.Folders("Example_Subfolder")
subFolder.Display
End Sub
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
On a shared inbox account, I would like to run a script if the email is unread.
I tried this:
Sub UnreadMail()
Dim myEmail As Object
Dim myNamespace As Object
Dim myFolder As Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
For Each myEmail In myFolder
If (myEmail.UnRead) Then
Call SaveAttachToDisk
End If
Next
End Sub
You almost got it, Try using GetSharedDefaultFolder Look at MSDN GetSharedDefaultFolder Method
Option Explicit
Sub UnreadMail()
Dim olNameSpace As Outlook.NameSpace
Dim olShareName As Outlook.Recipient
Dim olShareInbox As Outlook.Folder
Dim olItem As Outlook.MailItem
Set olNameSpace = Application.GetNamespace("MAPI")
Set olShareName = olNameSpace.CreateRecipient("Om3r#Email.com") 'address
Set olShareInbox = olNameSpace.GetSharedDefaultFolder(olShareName, olFolderInbox) 'Inbox
For Each olItem In olShareInbox.Items
If (olItem.UnRead) Then
'Call SaveAttachToDisk
Debug.Print olItem '// Print UnRead Item to Immediate window
End If
Next
End Sub
I need to get a folder by name, not by folder number counts. I tried getting with various methods.
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
'Dim OlFolder As Outlook.MAPIFolder
Dim objFolder As Outlook.Folder
Dim myolItems As Outlook.Items
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
'Set myOlItems = objNS.GetDefaultFolder(37).Folders("Vijay Baswal").Items
'Open the folder
Set objFolder = olApp.Session.GetDefaultFolder("Vijay Baswal")
Say under the Inbox was a folder named Clients and under that was a folder named Vijay Baswal
Set objFolder = objNS.GetDefaultFolder(olFolderInbox).Folders("Clients").Folders("Vijay Baswal")
OlDefaultFolders Enumeration http://msdn.microsoft.com/en-us/library/office/bb208072(v=office.12).aspx
The Inbox is olFolderInbox or 6. Appears there is no 37.
see below vba snippet to check how to read mail from specific folder
Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant
Dim outFolder As Outlook.Folder
Dim olItem As Outlook.MailItem
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.Folders("folder1").Folders("fol2")
Set olItms = olFldr.Items
olItms.Sort "Subject"
i = 1
For Each olItem In olItms
'If InStr(olMail.Subject, "Criteria") > 0 Then
Dim szVar As String
szVar = olItem.Body
szVar1 = olItem.Subject
i = i + 1
'End If
Next olItem
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
I have used the code above to access the main outlook Inbox but how to access the folders in inbox and it's mail using vba!
Thats very close :)
To get all the mail items in a folder called "temp" under the Inbox try this
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)
Set olFolder = olFolder.Folders("Temp")
For Each msg In olFolder.Items
Debug.Print msg.Subject
Next
And to drill further down, keep adding Set olFolder lines:
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("temp")
Set olFolder = olFolder.Folders("temp2")
Set olFolder = olFolder.Folders("temp3")
Gets you to \Inbox\temp\temp2\temp3\
I found that there were some items in my inbox that were not mail items causing the script to halt.
This little change allowed the script to keep running if something like a meeting invite is found:
Sub getmail()
Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
'Dim msg As Outlook.MailItem
Dim InboxItem As Object
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("temp")
For Each InboxItem In olFolder.Items
Debug.Print InboxItem.Subject
Debug.Print InboxItem.EntryID
Next
End Sub
Thanks for your answer! helped me a lot!
(My apologies - wanted to comment, but don't have enough rep..)