Outlook 2013 VBA display Shared Calendar - vba

I've got some VBa code that opens the Calendar in a new window, but I now need it to display the shared calendars that I've already got setup, but the only code I can find Creates a new shared calendar in the new window i've just created;
Sub DispCalendars()
Dim myOlApp As Outlook.Application
Dim myNms As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myRecipient As Outlook.Recipient
Dim myExplorer As Outlook.Explorer
Dim SharedFolder As Outlook.MAPIFolder
Set myOlApp = CreateObject("Outlook.Application")
Set myNms = myOlApp.GetNamespace("MAPI")
Set myFolder = myNms.GetDefaultFolder(olFolderCalendar)
Set myExplorer = myOlApp.ActiveExplorer
Set myExplorer.CurrentFolder = myFolder
Set myRecipient = myNms.CreateRecipient("Bob the Builder")
Set SharedFolder = myNms.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
myExplorer.SelectFolder SharedFolder
End Sub
If I change to 'myRecipient' part to just a name, it errors and I can't seem to work it out.
Here is something how it looks (when I do it manually) and I would like to recreate it in code.

I think you miss the line to show the Folder selected in Outlook
myExplorer.CurrentFolder = SharedFolder
i guess instead of the "selectfolder"-line... also some of the other lines could be deleted, espacially
Set myExplorer.CurrentFolder = myFolder
as it does not make sende to open two Folders one after another in one Sub.
Yours
Max

Related

Moving tasks from the TO-Do list to an "Inquiries" Task 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.

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.

Scope using AdvancedSearch method for entire mailbox

I am trying to look through all Outlook folders for mail items matching certain parameters to save the attachment, from Excel.
I don't know how to reference scope to go through all folders, even custom folders.
I can't find the resources that answer my question.
Sub testing()
Dim myOlApp As New Outlook.Application
Dim scope As String
Dim filter As String
Dim rsts As Results
Dim AdvancedSearch As Outlook.Search
blnSearchComp = False
'I want it to search the entire mail account including normal folders like inbox and sent as well as custom folders.
'but this doesn't work. Any ideas?
scope = "'Fakeexample123#outlook.com'"
'filter assignment statement has been excluded
Set AdvancedSearch = myOlApp.AdvancedSearch(scope, filter, True, "test")
While blnSearchComp <> True
If AdvancedSearch.Results.Count > 0 Then
blnSearchComp = True
End If
Wend
Set rsts = AdvancedSearch.Results
For x = rsts.Count To 1 Step -1
rsts.Attachment.Item(x).SaveAsFile Project
Next
End Sub
Scope should be
'\\Fakeexample123#outlook.com'
Sub Demo_scopeformat()
Dim myOlApp As New outlook.Application
Dim scope As String
' Mailbox
scope = "'" & myOlApp.Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"
' Expected format
Debug.Print scope
End Sub
Well, I know it isn't the best solution, but I have come up with the following code to make a list of all of the parent folders, so that a for loop can be used with advanced search method to iterate the list. This will not be the fastest possible code, but should not be too slow.
Sub main()
'establishes connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'pick highest folder level as original my folder
Set myFolder = objNS.Folders("faxe.example123#outlook.com")
Call ProcessFolders(myFolder)
End Sub
Sub ProcessFolders(myFolder)
're establish connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'set up collection
Set x = New Collection
For Each objFolder In myFolder.Folders
'add all parent folder names to collection
'advanced search method will handle subfolders
'can use a recursive call here also to get subfolders though
x.Add objFolder.Name
Next
Set objNS = Nothing
Set myFolder = Nothing
Set myOlApp = Nothing
End Sub

Set custom value when item moved to folder in outlook

I'm looking to set a Date on a field anytime an email is moved into a specific folder.
the field is custom called "Completed Date".
Could I get a little help on VBA code to set a custom field (date) when an item is moved into a folder (folder name is "Completed").
I'm ultimately looking to report on the time an item (custom form email) was received to the time it was completed (as per the action of moving the email to a completed folder.
Very rudimentary ticketing system, I'm very aware :) .
thanks,
A
Use ItemAdd http://www.outlookcode.com/article.aspx?id=62 where you reference the "Completed" folder.
Combine it with code like this http://www.vbaexpress.com/forum/showthread.php?5738-Need-to-Add-a-Userdefined-Property-to-Mail-Items
SAMPLE CODE
Change it so you do not update all items in the folder just the one item that triggered ItemAdd.
Option Explicit
Sub AddAUserDefinedProperty()
Dim olApplication As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim strDomain As String
Dim olProperty As Outlook.UserProperty
Set olApplication = New Outlook.Application
Set olNameSpace = olApplication.GetNamespace("Mapi")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderJunk)
For Each olItem In olFolder.Items
strDomain = Mid(olItem.SenderEmailAddress, _
InStr(1, olItem.SenderEmailAddress, "#") + 1)
Set olProperty = olItem.UserProperties.Add("Domain", olText)
olProperty.Value = strDomain
Debug.Print olItem.SenderEmailAddress, olProperty.Value
olItem.Save
Next olItem
Set olApplication = Nothing
Set olNameSpace = Nothing
Set olFolder = Nothing
Set olProperty = Nothing
End Sub
Even more reference material here http://www.codeproject.com/Articles/427913/Using-User-Defined-Fields-in-Outlook

Loop Through PSTs in Outlook 2003 with VBA

In Outlook 2007, I am able to loop through mails stores, including PSTs, using code like this:
Dim stores As Outlook.stores
Set stores = objNamespace.stores
Dim store As Outlook.store
For Each store In stores
MsgBox store.FilePath
Next
However, in Outlook 2003, the Outlook.store and Outlook.stores objects do not exist.
Are there equivalent objects in Outlook 2003?
What other method might I use to loop through mail stores?
Thank you.
This sample code for Outlook 2003 will loop through the high level mailboxes and print certain properties to the Immediate Window. I chose the properties that looked most useful based on your request.
Sub LoopThruMailboxes()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim mailboxCount As Long
Dim i As Long
Dim folder As Outlook.MAPIFolder
' get local namespace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
mailboxCount = olNS.Folders.count
For i = 1 To mailboxCount
Set folder = olNS.Folders(i)
Debug.Print folder.EntryID
Debug.Print folder.StoreID
Debug.Print folder.Name
Debug.Print folder.FolderPath
Next i
End Sub
folder.Name is the name of the mailbox, folder.StoreID is the store ID (I'm not sure what you meant by "store file path", I didn't see anything that looked relevant anyway).
Here's a functionized version that returns folder name and store ID as an array, which you could assign directly to a listbox:
Function GetMailBoxInfo() As String()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim mailboxCount As Long
Dim i As Long
Dim folder As Outlook.MAPIFolder
Dim tempString() As String
' get local namespace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
mailboxCount = olNS.Folders.count
' size array accordingly
ReDim tempString(1 To mailboxCount, 1 To 2)
For i = 1 To mailboxCount
Set folder = olNS.Folders(i)
tempString(i, 1) = folder.Name
tempString(i, 2) = folder.StoreID
Next i
GetMailBoxInfo = tempString
End Function
ex:
ListBox1.List = GetMailBoxInfo