This code fails:
Sub Clear_ItemCount()
Dim oAccount As MAPIFolder
Set oAccount = Application.Session.Folders("myaccount#gmail.com")
Dim oInbox As MAPIFolder
Set oInbox = oAccount.Folders("Inbox")
oInbox.ShowItemCount = olNoItemCount
Set oInbox = Nothing
Set oAccount = Nothing
End Sub
Item count is still visible:
According to this article, it seems that it should work. It says it does not work with "Public" folders, but, based on this article, i think "Public" folders are shared folders on an Exchange server (not using an Exchange server).
Is there a way to do this?
Related
I am having trouble getting my Outlook VBA code to recognize the subfolder in my Shared Tasks.
What I'm trying to do is create a macro that will automatically create a task in the department Shared Task folder. Tried Googling a variety of solutions to no avail. The code goes as follows:
Dim objApp As Outlook.Application
Dim defaultTasksFolder As Outlook.MAPIFolder
Dim subFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim objMail As MailItem
Dim objItm As TaskItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objMail = Outlook.Application.ActiveExplorer.Selection.Item(1)
Dim objOwner As Outlook.Recipient
Set objOwner = objNS.CreateRecipient("name#email.com")
objOwner.Resolve
If objOwner.Resolved Then
Set defaultTasksFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderTasks)
subFolder = defaultTasksFolder.Folders("TestFolder") **ERROR OCCURS HERE - OBJECT COULD NOT BE FOUND**
Set objItm = subFolder.Items.Add(olTaskItem)
With objItm
.Subject = "Name- " & objMail.Subject
.StartDate = objMail.ReceivedTime
.Body = objMail.Body
End With
objItm.Save
MsgBox ("Task Created for e-mail: " & vbCrLf & objMail.Subject)
End If
End Sub
It errors out on subFolder = defaultTasksFolder.Folders("TestFolder"), saying that the object could not be found. I double and tripled checked the folder name.
Any ideas what might be causing this error? Thank you!!
First of all, add the Logon method before accessing MAPI, it will log to the profile if Outlook has just been started. If it is already running it will not affect anything. Then try to add both mailboxes as delegate stores (see the Advanced tab of the Exchange account properties dialog). You should see both mailboxes.
Finally, I'd try to iterate over all folders before to make sure the folder exists. Also, I'd recommend checking the recipient's name.
Keep in mind that Outlook might cache only the default folders, but not their suborders.
Can you see and access the subfolder in Outlook?
I have some VBA code in Outlook which behaves perfectly for the main Mailbox - however the same code is struggling when I add a secondary mailbox - this is Outlook 2016.
It seems to be struggling with reading the sub folders - I can get it to read mail items in the Inbox, but not the sub folders.
Code :
Dim sharedemail As Outlook.Recipient
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder Outlook.MAPIFolder
Dim strSubject As String
Dim i As Integer
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set sharedemail = myNameSpace.CreateRecipient("recip#domain.com")
Set myInbox = myNameSpace.GetSharedDefaultFolder(sharedemail, olFolderInbox)
For itemCount = myInbox.items.Count To 1 Step -1 'Iterates from the end backwards
Set item = myInbox.items(itemCount)
strSubject = UCase(item.Subject)
Select Case True
Case InStr(strSubject, UCase("Holiday Request")) > 0
'Set destination folder
Set myDestFolder = myInbox.Folders("HolidayRequests")
'move the email out of inbox
item.Move myDestFolder
End Select
Next
It stalls at the Set myDestFolder line as it can't seem to select that sub folder - as I say same code seems to work fine in main Inbox?
Thanks
Keep in mind that Outlook keeps shared default folders in the primary OST file, and it does not sync the subfolders.
You can either
Uncheck the "Download shared folders" checkbox
Use Extended MAPI (C++ or Delphi) - that would be fairly complex as you'd need to retrieve the autodiscover XML for that mailbox and construct the store entry id appropriately.
use Redemption (I am its author) - its version of RDOSession.GetSharedDefaultFolder returns an online version of the folder (RDOFolder) with all its subfolders.
I'm looking for a vba code in excel, he should contacts from a shared mailbox (different exchange account called shared mailbox in outlook) transfer to a excel list, with the normal contacts from outlook it works I used this:
Set nsOutlook = applOutlook.GetNamespace("MAPI")
Set cfOutlook = nsOutlook.GetDefaultFolder(olFolderContacts)
with Set olcontacts = cfOutlook.Folders("name")
I have used the "name" where is displayed in outlook
it not works he not find the folder.
is there a solution without recipient?
because there will be several user-all with the same shared mailbox
I hope you can help me.
The Outlook object model provides the GetSharedDefaultFolder method of the Namespace class which returns a Folder object that represents the specified default folder for the specified user. For example:
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Dan Wilson")
myRecipient.Resolve
If myRecipient.Resolved Then
Call ShowCalendar(myNamespace, myRecipient)
End If
End Sub
Sub ShowCalendar(myNamespace, myRecipient)
Dim CalendarFolder As Outlook.Folder
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
CalendarFolder.Display
End Sub
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.
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.