Get email from non default inbox? - vba

I am using the following vba code to get emails from my inbox folder and move them to a sub folder called suppliers. At the moment the emails are moved from my default email inbox, but I have an account called purcashing#hewden.co.uk and I want it to get the emails from this inbox and move it to the subfolder called Suppliers in this account.
can someone show me how I would alter GetDefaultFolder to make this happen. thanks
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Supplier")
Set myItem = myItems.Find("[Subject] = 'Introduction'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub

Instead of using Namespace.GetDefaultFolder, retrieve the appropriate store from the Namespace.Stores collection and use Store.GetDefaultFolder.

I just used Dmitry's suggestion and it works like a charm.
Hope it helps \o/
Sub GetEmailFromNonDefaultInbox()
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myInbox As Outlook.MAPIFolder
Dim myitems As Outlook.Items
Dim strFilter As String
' let the user choose which account to use
Set myAccounts = myOlApp.GetNamespace("MAPI").Stores
For i = 1 To myAccounts.count
res = MsgBox(myAccounts.Item(i).DisplayName & "?", vbYesNo)
If res = vbYes Then
Set myInbox = myAccounts.Item(i).GetDefaultFolder(olFolderInbox)
Exit For
End If
Next
If myInbox Is Nothing Then Exit Sub ' avoid error if no account is chosen
' query emails by subject
strFilter = "#SQL=""urn:schemas:httpmail:subject"" like '%YOUR SUBJECT%'"
Set myitems = myInbox.Items.Restrict(strFilter)
' show some feedback if no email is found
If myitems.count = 0 Then
MsgBox "Nothing found. Try another account."
Exit Sub
End If
' get the most recent email
myitems.Sort "ReceivedTime", True
Set myitem = myitems.GetFirst
If myitem.Class = olMail Then
' and now you can do whatever you want
MsgBox (myitem.Subject)
End If
End Sub

Related

Set mails read if they were read in another folder

I'm trying to make an outlook macro, which will 'update' the mails. I have an Inbox folder and an another one. (2 mail accunts)
There is a rule, which is copying the mail from another folder to my inbox.
My goal is to set the mail as read in another folder, if it was read in the Inbox folder.
Sub precitane()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim mydeffolder As Outlook.Folder
Dim items As Object
Dim defitems As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myDestFolder = myNameSpace.Folders("") 'mymail
Set mydeffolder = myNameSpace.GetDefaultFolder(olFolderInbox)
For Each items In myDestFolder.items
For Each defitems In mydeffolder.items
If TypeOf items Is Outlook.MailItem & TypeOf defitems Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = items
Dim defMail As Outlook.MailItem: Set defMail = defitems
If oMail.SenderEmailAddress = "" & defMail.SenderEmailAddress = "" & defMail.Body = oMail.Body & defMail.UnRead = False Then
oMail.UnRead = True
oMail.Save
End If
End If
Next
Next
On Error GoTo 0
End Sub
"" contains my mail...
It looks like you tried with code from other than VBA.
I broke the If statement into separate parts as it is easier to follow and to debug.
Option Explicit
Sub precitane()
Dim myDestFolder As Folder
Dim mydeffolder As Folder
Dim item As Object
Dim defItem As Object
Set myDestFolder = Session.Folders("mailAddress2").Folders("Inbox").Folders("Test")
Set mydeffolder = Session.GetDefaultFolder(olFolderInbox).Folders("Test3")
For Each item In myDestFolder.items
If TypeOf item Is MailItem Then
For Each defItem In mydeffolder.items
If TypeOf defItem Is MailItem Then
If item.senderEmailAddress = defItem.senderEmailAddress Then
If item.Body = defItem.Body Then
If item.UnRead = False Then
defItem.UnRead = False
'If necessary
'item.Save
Exit For
End If
End If
End If
End If
Set defItem = Nothing
Next
End If
Set item = Nothing
Next
Debug.Print "Done."
End Sub

How to forward, a mailItem copied from shared mailbox to local email folder, from local email?

I copy an email from a shared mailbox to a local folder in my Outlook.
I am trying to forward the email from my local email account.
When I do this, it is sent from the shared mailbox account.
I set the account on the email as the confirmed correct account.
mailItem.Move myDestFolder
Set mailItem2 = mailItem.Forward
mailItem2.SendUsingAccount = oAccount (where oAccount is OutApp.Session.Accounts.Item (1))
mailItem2.Send
set mailItem2.SendUsingAccount = oAccount results in error
Property is Read-Only
Wondering if I don't have permissions to set this?
Option Explicit
Private rcvMail As Outlook.MailItem
Private fwMail As Outlook.MailItem
Private Const STR_MOVED_FOLDER As String = "Moved Emails"
Sub MoveAndForward()
Dim myNamespace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim rcvFolder As Outlook.Folder
Dim oAccount As Outlook.Account
Dim myItems As Outlook.Items
Dim myItem As Object
Dim OutApp1 As Object
Dim mailBoxFolderName As String
Dim iEmailAccount As Integer
Dim iRecipientCount As Integer
Dim i As Integer
Set OutApp1 = CreateObject("Outlook.Application")
Set oAccount = OutApp1.Session.Accounts.Item(1)
Set myNamespace = Application.GetNamespace("MAPI")
Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
CheckOrCreateFolder
Set myDestFolder = myInbox.Folders(STR_MOVED_FOLDER)
Set rcvMail = ReturnCurrentItem()
If rcvMail.Class <> olMail Then
MsgBox "This cannot be saved to file." & vbCrLf & _
"Only Mail Items are supported.", vbExclamation, "Error"
Exit Sub
End If
Set rcvFolder = rcvMail.Parent
mailBoxFolderName = rcvFolder.Name
rcvMail.Move myDestFolder
Set fwMail = rcvMail.Forward
Set fwMail.SendUsingAccount = oAccount
iRecipientCount = fwMail.Recipients.Count
If iRecipientCount > 0 Then
For i = iRecipientCount To 1 Step -1
fwMail.Recipients.Remove (i)
Next i
End If
fwMail.Recipients.Add "*****#***.com"
fwMail.Recipients.ResolveAll
fwMail.Body = myNamespace.CurrentUser & " Took this email from the Mailbox" & _
vbCrLf & rcvMail.Body
fwMail.Send
rcvMail.Close (olDiscard)
Set rcvMail = Nothing
Set fwMail = Nothing
Set myNamespace = Nothing
Set myInbox = Nothing
Set myItems = Nothing
Set myDestFolder = Nothing
End
End Sub

Reference a shared inbox account

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

Getting an EntryID after an object is moved

Summary
I'm trying to add hyperlinks to tasks created from emails that I have moved to another folder.
The goal is to have the task contain a hyperlink to the Outlook item that was moved to a "Processed Email" folder".
Problem
I don't understand how to move a MailItem and then get its new EntryID after it moves.
The "naive" way doesn't work. After using the Move method to move a MailItem object, the EntryID property does not reflect a change in ID.
Details
Creating a hyperlink to an Outlook item using the format outlook:<EntryID> is easy enough if the Outlook item remains in the Inbox, since I can just get the EntryID of the object that I am linking to. However, Outlook changes the EntryID when an object is moved.
I want to understand how to get the updated ID so that I can construct an accurate link.
Example
The message boxes show the EntryID property of objMail returns the same value despite the fact that the object has moved. However, running a separate macro on the mail in the destination folder confirms that the EntryID has changed with the move.
Sub MoveObject(objItem As Object)
Select Case objItem.Class
Case olMail
Dim objMail As MailItem
Set objMail = objItem
MsgBox (objMail.EntryID)
Dim inBox As Outlook.MAPIFolder
Set inBox = Application.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim destFolder As Outlook.MAPIFolder
Set destFolder = inBox.Folders("Processed Email")
If (Application.ActiveExplorer().CurrentFolder.Name <> destFolder.Name) Then
objMail.Move destFolder
End If
MsgBox (objMail.EntryID)
End Select
End Sub
The Move method of the MailItem class returns an object that represents the item which has been moved to the designated folder. You need to check out the EntryID value of the returned object, not the source one.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Personal Mail")
Set myItem = myItems.Find("[SenderName] = 'Eugene Astafiev'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
Hello can you please elaborate your answer I am not able to understand it.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Here is my code and I need EntryID after moving.
Sub Movetest1()
Dim olApp As Outlook.Application
Dim olns As Outlook.NameSpace
Dim Fld As Folder
Dim ofSubO As Outlook.MAPIFolder
Dim myDestFolder As Outlook.Folder
Dim ofolders As Outlook.Folders
Dim objItems As Outlook.Items
Dim myRestrictItems As Outlook.Items
Dim i As Long
Dim myitem As Object
' Dim MailItem As Microsoft.Office.Interop.Outlook.MailItem
Dim MailItem, moveditem As Outlook.MailItem
Dim eid As String
Dim sid As Variant
Dim newEID As String
'---------------------------------------------------------------------------------------------------------
Set olApp = New Outlook.Application
Set olns = olApp.GetNamespace("MAPI")
For Each Fld In olns.Folders
If Fld.Name = "GSS Payables" Then
'
' MsgBox Fld.Name
' Debug.Print " - "; Fld.EntryID
Set Fld = olns.GetFolderFromID("000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000").Folders("Inbox")
Exit For
End If
Next
Set objItems = Fld.Items
eid = "000000009DA6D76FBE7A58489450CDF6094F592A0700A2457DC435B22448A832DB721D8185B1000000B620800000A2457DC435B22448A832DB721D8185B100007FF773270000"
sid = "000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000"
Set myDestFolder = Fld.Folders("Bhagyashri")
'Set myitem = objItems.Find("[SenderName]='Microsoft Outlook '")
Set MailItem = olns.GetItemFromID(eid)
Set moveditem = MailItem.Move(myDestFolder)
"giving error here
newID = moveditem.entryid
Debug.Print "newID -"; newID
' get mailitem.parent.storeid
MsgBox "done"
End
Use the following syntax:
Dim MoveToFolder As outlook.MAPIFolder
Dim MyItem As outlook.MailItem
Dim NewEntryID As String
NewEntryID = MyItem.Move(MoveToFolder).ENTRYID
After MyItem.Move is executed the new ENTRYID will be returned to the NewEntryID variable.

Outlook VBA - Move to folder - Body text

I tried to create a script which searches the body text and sender name from an incoming email and if true move the email to a subfolder.
I tried to add this code to ThisOutlookSession but it is not working.
Public Sub MailtoFolder(Item As Outlook.MailItem)
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("xTest")
If InStr(Item.Body, "Test123") > 0 And Item.SenderName = "Jon" Then
Item.Move myDestFolder
End If
Set myDestFolder = Nothing
Set myInbox = Nothing
Set myNameSpace = Nothing
End Sub
Any ideas where I made a fault?
Your "Item" so far is not set.
If you wish to apply this to the currently opened e-mail, this would be e.g.
Set Item=Application.ActiveExplorer.Selection.Item(1)
If you wish to loop through all mails in your folder, you need to do exactly that:
Set myDestFolder = myInbox.Folders("xTest")
For Each mailItem in myDestFolder.Items
' ... do your magic
Next mailItem