I'm trying to open the Outlook contacts folder from a secondary email account.
This code will display the contacts on my default email account.
I tried .Session.Accounts. Is there a way I can open a folder from the path? If so, how would I get the path for contacts folder?
Private Sub Command12_Click()
Dim xOutlookApp As Outlook.Application
Dim xNameSpace As Outlook.NameSpace
Dim xFolder As Outlook.Folder
'
'On Error Resume Next
Set xOutlookApp = New Outlook.Application
Set xNameSpace = xOutlookApp.Session
Set xFolder = xNameSpace.GetDefaultFolder(10)
xFolder.Display
'
Set xFolder = Nothing
Set xNameSpace = Nothing
Set xOutlookApp = Nothing
Exit Sub
Instead of calling Namespace.GetDefaultFolder, call Store.GetDefaultFolder. A Store object can be retrieved from the Namespace.Stores collection.
Related
I am trying to access the Folder from Outlook in VBA,some folder I am able to access but few folder are not. Although I am able to read 1 subfolder from the below code but when i am trying to change folder it is giving error.
This the code with which I am trying to access :
Public Sub ReadOutlookEmails()
Dim out_app As Outlook.Application
Dim get_name As Outlook.Namespace
Dim get_folder As Outlook.MAPIFolder
Dim oAccount As Object
Dim store_add As Object
Dim monthKeyValuePair As New Scripting.Dictionary
Dim email_list As New mscorlib.ArrayList
Dim date_List As New mscorlib.ArrayList
For Each c In Worksheets(ActiveSheet.Name).Range("D8:AH8")
date_List.Add c
'MsgBox c
Next c
Set out_app = New Outlook.Application
Set get_name = out_app.GetNamespace("MAPI")
For Each oAccount In out_app.Session.Accounts
If oAccount.SmtpAddress = "chhabranaveen#gmail.com" Then
Set store_add = oAccount.DeliveryStore
'MsgBox store_add.GetDefaultFolder(olFolderInbox).Folders("New Joinees")
'Set get_folder = store_add.GetDefaultFolder(olFolderInbox).Folders("On Bench Training")
Set get_folder = store_add.GetDefaultFolder(olFolderInbox)
Set get_folder = get_folder.Folders("On Bench Training")
Please help me here what I am doing wrong.
The error is MAPI_E_NOT_FOUND, which means the folder with the given name does not exist.
Make sure the folder named "On Bench Training" is really a subfolder of the Inbox.
Instead of getting the folder by its name you may try iterating over all subfolders and checking their name. So, basically instead of the following line:
Set get_folder = get_folder.Folders("On Bench Training")
You may iterate over all subfolder:
For Each uFolder In get_folder.Folders
If uFolder.Name = "On Bench Training" Then
MsgBox "Found!"
End If
Next uFolder
Regretfully I have no formal background in VBA, but I have been able to learn quite a bit from sites like this.
Problem Statement:
I have a few emails with contain information that needs to be stored in excel. Fortunately I do have working script for that. Not provided to keep this somewhat shorter
The problem that I am facing is that capturing the right email from Microsoft Outlook 2010 and storing the data WITHOUT manual intervention.
The Email will contain a specific word/phrase, "EVEREST". Obviously it is not the only email received. It contains no attachments, and will come from various senders.
I have tried various macros I have found on-line to pull the message from the inbox, but none of them have worked for me.
So I have a macros that will pull messages from a personal folder, that macro then runs another macros that stores the contents of the email to excel, then it moves the message to its final resting place (another personal Folder) currently they all work fine together, but require manual intervention to complete the task. After the message is moved to the personal folder I simply click on a Quick Access Toolboar Icon mapped to a macro
To get the message moved over the personal folder i have a rule set up to move the message based on the word "EVEREST" and runs the initial script.
The problem with all of this is that the message will get moved to the folder, but needs manual intervention to complete the task. I would like it to run automatically.
I have been fumbling around with this for the past 2 months and seem to be in a stalemate. I would greatly appreciate your feedback and assistance.
The following is what I have so far.
My outlook rule set is:
Apply this rule after the message arrives
with "EVEREST" in the subject
and on this computer only
move it to the "EVEREST PRI" folder
and run "Project1.ThisOutlookSession.Everest"
' I believe these were put here when I was trying to run '
' everything via VBA macros, vice using the rule set above '
CLass Module (1)
Option Explicit
Private WithEvents Items As Outlook.Items
Private WithEvents olInboxItems As Items
' ThisOutlookSession contains the following scripts '
'This is the script that is run from the outlook rules '
' all it does is calls the "OCF" Sub below '
Sub Everest(email As MailItem)
OCF
End Sub
'This scipt opens the "EVEREST PRI" personal sub folder'
' and calls the "Prepwork" sub below '
Sub OCF()
Dim objOlApp As Outlook.Application
Dim Ns As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim EmailCount As Integer
Set objOlApp = CreateObject("Outlook.Application")
Set Ns = Session.Application.GetNamespace("MAPI")
Set objFolder = Ns.Folders("Personal Folders").Folders("Archives").Folders("EVEREST PRI")
Set objOlApp.ActiveExplorer.CurrentFolder = objFolder
Set objFolder = Nothing
Set objOlApp = Nothing
Prepwork
End Sub
'I had hoped that the following routine would do the rest of the work '
'but it doesn't do it all the time. Most the time the message hasn't been '
'moved to the personal folder before its kicked off. '
'So I thought I would call another macro to play catch up "Wait" below '
Sub Prepwork()
Dim objOlApp As Outlook.Application
Dim Ns As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim EmailCount As Integer
Set objOlApp = CreateObject("Outlook.Application")
Set Ns = Session.Application.GetNamespace("MAPI")
Set objFolder = Ns.Folders("Personal Folders").Folders("Archives").Folders("EVEREST PRI")
Set objOlApp.ActiveExplorer.CurrentFolder = objFolder
EmailCount = objFolder.Items.count
If EmailCount = 1 Then
'MsgBox "A COMSPOT has been recieved, acknowledge to update the chart'
' I tried adding this msgbox to provide some time delay, although '
' it has worked from time to time, it still requires manual '
' intervention, which is not desired. '
CopyToExcel
' CopyToExcel is the macro that writes my information to the '
' Spreadsheet. This script has been flawless and I have created '
' a Clickable ICON in the Quick Access Toolboar. '
ElseIf EmailCount = 0 Then
Wait
End If
End Sub
'The following "Wait Script was added, hoping to give time for the other '
'macros to finish, but i suspect they are all linked together, and wont '
'finish until all macroshave finished including the previously mentioned '
' "CopyToExcel" macro. '
' I have also tried to run this macro from the outlook rules, no joy......'
Sub Wait() '(email As MailItem)
' this provides a 5 second wait'
Sleep (5000)
Dim objOlApp As Outlook.Application
Dim Ns As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Dim EmailCount As Integer
Set objOlApp = CreateObject("Outlook.Application")
Set Ns = Session.Application.GetNamespace("MAPI")
Set objFolder = Ns.Folders("Personal Folders").Folders("Archives").Folders("EVEREST PRI")
Set objOlApp.ActiveExplorer.CurrentFolder = objFolder
EmailCount = objFolder.Items.count
If EmailCount = 1 Then
'MsgBox "A COMSPOT has been recieved, acknowledge to update the chart"
CopyToExcel
ElseIf EmailCount = 0 Then
' MsgBox "The second Marco (Wait) did not locate a Message in the PRI Folder. Run the script from the Quick Access Toolboar"
End If
End Sub
' The following macro moves each of the selected items on the screen to an'
' Archive folder. I have not had any problems with this macro '
' This macro is called from the "CopyToExcel" macro. (not shown as it '
' has also worked fine since incorporating it '
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")
' This assumes that you have an Inbox subfolder named Archive.
Set olArchive = olNameSpace.Folders("Personal Folders").Folders("Archives").Folders("EVEREST Archive")
For intItem = 1 To olSel.count
olSel.Item(intItem).Move olArchive
Next intItem
OIB
End Sub
' The following macro simply returns the view to the inbox folder, '
' Thus returning everything to Normal '
' The Ideal of returning to which every folder, or message was open at '
' the time the EVEREST message first arrived I thought would be to '
' complicated, but if any body could solve that... AMAZING.... '
Sub OIB()
Dim objOlApp As Outlook.Application
Dim Ns As Outlook.NameSpace
Dim objFolder As Outlook.Folder
Set objOlApp = CreateObject("Outlook.Application")
Set objFolder = Session.GetDefaultFolder(olFolderInbox)
Set objOlApp.ActiveExplorer.CurrentFolder = objFolder
Set objFolder = Nothing
Set objOlApp = Nothing
End Sub
There is no need to select, you already have the required "email" passed as a parameter by the rule.
The run a script code will look something like this.
Sub Everest(email As MailItem)
Dim Ns As NameSpace
'Dim inboxFolder As Folder
Dim olArchive As Folder
Set Ns = GetNamespace("MAPI")
CopyToExcelWithParameter email
'ArchiveItems
Set olArchive = Ns.Folders("Personal Folders")
Set olArchive = olArchive.Folders("Archives")
Set olArchive = olArchive.Folders("EVEREST Archive")
email.Move olArchive
' Edit: Just realized this was due to
' unnecessary folder selecting that is now gone
' This is unnecessary now as well
'OIB
'Set inboxFolder = Ns.GetDefaultFolder(olFolderInbox)
'Set ActiveExplorer.CurrentFolder = inboxFolder
Set Ns = Nothing
Set olArchive = Nothing
'Set inboxFolder = Nothing
End Sub
You will have to rewrite CopyToExcel to take email as a parameter
Sub CopyToExcelWithParameter (email as mailitem)
' code that processes "email" directly, not a selection
Debug.Print "Do something with " & email.subject
End Sub
Okay, I was reading a tutorial on how to access parent folders outside of the Inbox and noticed that it was using "Set". To my knowledge, this command is deprecated and seems so whenever I have tried to use it in my code.
http://blogs.technet.com/b/heyscriptingguy/archive/2006/08/03/how-can-i-get-access-to-a-mail-folder-that-isn-t-a-subfolder-of-my-outlook-inbox.aspx
' Set Outlook parameters
objOutlook = CreateObject("Outlook.Application")
iNameSpace = myOlApp.GetNamespace("MAPI") ' Set current NameSpace
Dim oExp As Outlook.Explorer
Dim oSel As Outlook.Selection
oExp = objOutlook.ActiveExplorer
oSel = oExp.Selection
Dim strFolderName As Object
Dim objInbox As Outlook.Folder
Dim objMailbox As Outlook.Folder
Dim objFolder As Outlook.Folder
Const olFolderInbox = 6
objInbox = iNameSpace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Folders.Parent()
objMailbox = iNameSpace.Folders(strFolderName)
objFolder = objMailbox.Folders("Europe")
When trying the code above, I get a type error: Additional information: Type mismatch, on this line:
objMailbox = iNameSpace.Folders(strFolderName)
When I change this to an "Object", I get the same error.
Any Idea what I am doing wrong?
To access the parent of the Inbox folder, try iNameSpace.GetDefaultFolder(olFolderInbox).Parent
To access a folder on the same level as the Inbox, try iNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders.Item("The Folder name")
The following code will not work.
strFolderName = objInbox.Folders.Parent()
The Folders collection does't provide the Parent method.
objMailbox = iNameSpace.Folders(strFolderName)
The Folders property doesn't accept an object arguments.
I have the following code which I believe should work to save attachments from an Outlook subfolder to the specified path, before emptying the subfolder.
Sub Downloadattachments()
Dim applOutlook As Outlook.Application
Dim ns As Namespace
Dim inbox As MAPIFolder
Dim item As Object
Dim atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim SubSubFolder As MAPIFolder
Dim VariableName As Name
Set ns = GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = inbox.Folders("Paul")
Set SubSubFolder = SubFolder.Folders("Soja")
i = 0
If SubSubFolder.Items.Count = 0 Then
MsgBox
Else: End If
If SubSubFolder.Items.Count > 0 Then
For Each item In SubSubFolder.Items
For Each atmt In item.attachments
FileName = "\\homefolder5\bases" & atmt.FileName
atmt.SaveAsFile FileName
i = i + 1
item.Delete
Next atmt
Next item
End If
End Sub
Unfortunately I don't get past the line Set ns = GetNamespace("MAPI") before encountering the run-time error stating "Automation error: Library not registered". To clarify, I have the Microsoft Outlook 14.0 Object Library activated, along with other basic libraries. I think this must be something different.
I apologize if this is a really simple thing that I am overlooking, but I would appreciate whatever guidance you could give me!
Where do you run the VBA macro?
Dim applOutlook As Outlook.Application
It looks like you didn't initialize the applOutlook object in the code. If you develop an Outlook VBA macro, you can use the Application property:
Set applOutlook = Application
Set ns = applOutlook.GetNamespace("MAPI")
In case if you automate Outlook you need to create a new instance of the Application class. See How to automate Outlook from another program for more information.
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.