Updating shared calendar - excel

I am trying to update a shared calendar from an Excel sheet. The code works for the owner of this shared calendar, but it fails for me. The calendar was shared to me and I have full owner permissions.
I can edit the calendar manually, but the idea is that anyone will be able run the macro from this Excel sheet to update the shared calendar.
The relevant code, up to the failure point:
Sub UpdateSched()
Dim olApp As Outlook.Application
Dim olNameSpace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olFldrOwner As Outlook.Recipient
On Error Resume Next
' check if Outlook is running
Set olApp = GetObject("Outlook.Application")
If Err <> 0 Then
'if not running, start it
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFldrOwner = olNameSpace.CreateRecipient("ownrAlias")
olFldrOwner.Resolve
Set olFolder = Nothing
If olFldrOwner.Resolved Then
Set olFolder = olNameSpace.GetSharedDefaultFolder(olFldrOwner, olFolderCalendar)
' If olFolder Is Nothing Then
' Debug.Print "Nothing"
' Else
' Debug.Print olFolder.Name '<-Error here if the if-block is run
' End If
'******************************
Set olFolder = olFolder.Folders("Transport Sched") '<-Object Not Found Error
'******************************
End If
'Code below updates appointments on the shared calendar
The full error
'The attempted operation failed. An object could not be found'
For testing, I added the commented out block. This made me think that the error might be in the previous line. When this block is un-commented then the code errors out on the line after Else (same error). So the olFolder object is not nothing, but it can't be found.
It's under "Shared Calendars" I get the error. It updates a calendar I created, that's under "My Calendars."
Is it a problem with finding the correct folder for the shared calendar?
The path to the folder shouldn't change, so I could hard-code it so it works for everyone, is that possible?

I came up with a solution to my problem but in a completely different way than I was trying with the code listed in the question. In case anyone else needs it, here is the solution:
Sub ListCalendars()
Dim olApp As Outlook.Application
Dim olPane As Outlook.NavigationPane
Dim olModule As Outlook.CalendarModule
Dim olGroup As Outlook.NavigationGroup
Dim olNavFolder As Outlook.NavigationFolder
Dim olFolder As Folder
Dim i As Integer, j As Integer
On Error Resume Next
' check if Outlook is running
Set olApp = GetObject("Outlook.Application")
If Err <> 0 Then
'if not running, start it
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set olPane = olApp.ActiveExplorer.NavigationPane
Set olModule = olPane.Modules.GetNavigationModule(olModuleCalendar)
Set olGroup = olModule.NavigationGroups.GetDefaultNavigationGroup(olMyFoldersGroup)
'Dummy Do loop allows exit from within nested For-Next loops
Do
For i = 1 To olModule.NavigationGroups.Count 'Cycle through all Nav Groups
Set olGroup = olModule.NavigationGroups.Item(i)
Debug.Print olGroup.Name
For j = 1 To olGroup.NavigationFolders.Count 'Cycle through all calendars in group
Set olNavFolder = olGroup.NavigationFolders.Item(j)
Debug.Print " - " & olNavFolder.DisplayName
'Un-comment If-block below if searching for a particular calendar:
'CalendarName is the name of the calendar,as listed in your navigation pane
' If olNavFolder.DisplayName = "CalendarName" Then
' Debug.Print "Found it!"
' Set olFolder = olNavFolder.Folder 'To get folder object from NavigationFolder
' Exit Do
' End If
Next
Next
Exit Do 'To prevent endless loop
Loop While True
'If-block below displays results if looking for matching calendar name
'If olFolder Is Nothing Then
' Debug.Print vbNewLine & "No match found"
'Else
' Debug.Print vbNewLine & "Matching calendar found: " & olFolder.Name
'End If
End Sub
This code was modified from this page here. Basically, accessing someone else's calendar folder object directly gave me issues, even if the calendar had been shared. By using the various navigation objects though, I was able to cycle through all the calendars listed in my navigation pane, including all the shared calendars.
As provided this routine merely lists the main folders and one level of subfolders. If the two if-blocks are uncommented then the routine will search for the calendar with a given name(just replace CalendarName) and will display whether or not a match was found.
The dummy Do loop was one way to break out of nested loops. There's multiple other ways to accomplish this listed in this SO question.
One other tricky thing is that NavigationFolder objects are NOT the same as Folder objects. This seemingly inconsequential line:
Set olFolder = olNavFolder.Folder
is actually very important if you want to make changes to the calendar folder, since these two object types have different properties and methods.

Related

Look through 2 outlook root folders in Excel with VBA

I have managed to get access to the items in 2 folders in Outlook from Excel by using VBA, but now I want to search for the email address x#gmail.com in both aI know how to search each one individually, but once, and sort for the most recent one. The piece I am stuck on is how to look through both folders at once.
I am using Microsoft Office 2016
Obviously, this dummy line does not do the trick: Set olJoinedFldr = olCleanUp + olFldr
Private Sub CommandButton2_Click()
Dim olApp As Outlook.Application 'set app
Dim olNs As Object 'get namespace
Dim olFldr As Outlook.Folder 'to be the inbox
Dim olArchive As Outlook.Folder 'the archive folder
Dim olCleanUp As Outlook.Folder ' the archive subfolder we need
Dim olJoinedFldr As Object 'the to be made joined object to filter....
Dim olItems As Object 'filtered items based on search criteria
Dim olItemReply As Object 'the reply mail
Dim i As Long
Dim emailStr As String
Dim filter As String
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox
Set olArchive = olNs.Folders(CStr(olNs.Accounts.Item(1))) 'find email of current user
Set olCleanUp = olArchive.Folders("Archive").Folders("Cleanup") ' get the archive sub folder
Set olJoinedFldr = olCleanUp + olFldr
Set emailStr = "somebody#gmail.com"
filter = "[SenderEmailAddress] = """ & emailStr & """" 'this is the email from person x we are searching for in the 2 folders
' from here on it is currently searching just 1 folder
Set olItems = olFldr.Items.Restrict(filter) 'filter the items
olItems.Sort "[ReceivedTime]", True 'sort by date
If olItems.Count > 0 Then
For i = 1 To olItems.Count
If olItems(i).Class = 43 Then
Set olItemReply = olItems(i).ReplyAll
With olItemReply
.HTMLBody = "<p Dear someone, <br><br></p>" & .HTMLBody
.Display
End With
Exit For
End If
Next
Else
' have code here to make a brand new email already
End If
Set olApp = Nothing
Set olNs = Nothing
Set olFldr = Nothing
Set olArchive = Nothing
Set olCleanUp = Nothing
Set olJoinedFldr = Nothing
Set olItems = Nothing
Set olItemReply = Nothing
Set i = Nothing
Set emailStr = Nothing
Set filter = Nothing
End Sub
You cannot search through two (or more) folders unless you create a Search object using Application.AdvancedSearch. Even then, it is a PITA to work with - the search is asynchronous, and you would need to use events to figure out when the search is completed.
You'd be better off searching one folder at a time and combining the results (if necessary) in your code.
You need to use the AdvancedSearch method of the Application class. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
Read more about this method in the Advanced search in Outlook programmatically: C#, VB.NET article.

Run-Time Error 462 - Delete Outlook Appointments from Excel

The code below deletes appointments in a subfolder of the Outlook default calendar. I have commented out the line giving the run-time error 462: "The remote server machine does not exist or is unavailable".
Is there a change I could make to this code to solve this error? Thanks for any guidance.
Public Sub DeleteAppt()
Dim olApp As Object 'Outlook.Application
Dim olNS As Object 'Outlook.Namespace
Dim olAptItemFolder As Object 'Outlook.Folder
Dim olAptItem As Object 'Outlook.AppointmentItem
Dim i As Long
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.Session
Set olAptItemFolder = olNS.GetDefaultFolder(olFolderCalendar).Folders("TestCal")
''''For i = olAptItemFolder.Count To 1 Step -1
Set olAptItem = olAptItemFolder.Items(i)
If olAptItem.Subject Like "***" Then
olAptItem.Delete
End If
Next i
Set olAptItem = Nothing
Set olAptItemFolder = Nothing
Set olApp = Nothing
End Sub
olAptItemFolder has no Count property. olAptItemFolder.Items does. Apart from the issues others noted in comments above, try
For i = olAptItemFolder.Items.Count To 1 Step -1
Edited to add: if you are not setting a reference to something's object lirary, you can't use its enums unless you fully qualify each use. It's generally simpler, easier and quicker to find out the numerical value of the enum and use that instead. Then add a comment on the end of the line to remind yoursef, six months from now, that '9 = olFolderCalendar

Excel VBA, return GAL value

i have a very simple small app in mind which will help me save time from alt tabbing from excel to outlook. i want to create a small userform that will have a textbox for a exchange user alias and return the exchange user's full name. now the issue i have here is that the guide in msdn is a little vague for a userform: https://msdn.microsoft.com/en-us/library/office/ff869721.aspx and i'm getting some error messages, some got fixed by activating some references. and the code is quite complicated.
so basically i have 2 textboxes and a button. textbox1 will accept the alias, textbox2 will return the username after clicking the button.
there are several examples but most of them will result in dumping the GAL to an excel file which i don't need.
thanks in advanced
This will give you what you want.
Private Function GetFullName(inAlias As String) As String
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olAdd As Outlook.AddressEntries
Dim olMem As Outlook.AddressEntry
Dim olLst As Outlook.AddressList
Dim olAlias As String
On Error Resume Next
Set olApp = New Outlook.Application
On Error GoTo 0
If olApp Is Nothing Then
GetFullName = "Source not available"
Exit Function
End If
Set olNS = olApp.GetNamespace("MAPI")
Set olLst = olNS.GetGlobalAddressList
Set olAdd = olLst.AddressEntries
For Each olMem In olAdd
On Error Resume Next
olAlias = olMem.GetExchangeUser.Alias
On Error GoTo 0
If olAlias = inAlias Then
GetFullName = olMem.GetExchangeUser.Name
Exit For
Else
GetFullName = "Invalid Alias"
End If
Next
Set olApp = Nothing: Set olNS = Nothing: Set olAdd = Nothing
End Function
The draw back is this may take a while if your GAL is quite large.
I'll check if I can dump the list to an array first and then manipulate from there.
Or if there is another way to get to the name via alias using other method.
But for now, try learning from this first.
This is a function, so to get it to your textbox, you can simply:
TextBox2 = GetFullname(TextBox1)
Note:
I intentionally declared all the objects, you need to know what type of object you're working on. Also I used On Error Resume Next because there are AddressEntry without Alias and that gives error. That's the easiest work around I can think of for now.
Requirement:
You need to reference Microsoft Outlook xx.x Object Library.
xx.x vary depending on the Outlook version installed in your machine.

Exporting Outlook Email information to Excel Workbook

I receive an automated email message (in Outlook) every time a room is reserved in a scheduling system but then have to go over and mirror that reservation in another system (which necessitates checking each reservation for specific information and searching through the inbox). I am trying to determine if there is a way to pull the information from the message section (I have found some code that pulls the date received, and subject line as well as read status, but cannot determine how to pull the message body information that I need)
The code that I am running is courtesy of Jie Jenn:
Sub ListOutlookEmailInfoinExcel()
Dim olNS As Outlook.NameSpace
Dim olTaskFolder As Outlook.MAPIFolder
Dim olTask As Outlook.TaskItem
Dim olItems As Outlook.Items
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim x As Long
Dim arrHeaders As Variant
Set olNS = GetNamespace("MAPI")
Set olTaskFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olTaskFolder.Items
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add
On Error Resume Next
x = 2
arrHeaders = Array("Date Created", "Date Recieved", "Subject", "Unread?")
xlWB.Worksheets(1).Range("A1").Resize(1, UBound(arrHeaders)).Value = ""
Do
With xlWB.Worksheets(1)
If Not (olItems(x).Subjects = "" And olItems(x).CreationTime = "") Then
.Range("A1").Resize(1, UBound(arrHeaders) + 1) = arrHeaders
.Cells(x, 1).Value = olItems(x).CreationTime
.Cells(x, 2).Value = olItems(x).ReceivedTime
.Cells(x, 3).Value = olItems(x).Subject
.Cells(x, 4).Value = olItems(x).UnRead
x = x + 1
End If
End With
Loop Until x >= olItems.Count + 1
Set olNS = Nothing
Set olTaskFolder = Nothing
Set olItems = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
End Sub
With the above code, I get a readout of the Subject line, the date created/received and whether or not it has been read. I am trying to see if I can, in addition, get some of the unique string data within the message itself. The format of the emails that I receive is as follows:
Message-ID: sample info
User: test
Content1: test
Content2: test
Content3: test
Please submit a service request if you are receiving this message in error.
-Notice of NEW Room Request
Sponsored By: My_example#Test.com
Event Type: Meeting
Event Title: Test
Date of Reservation: 2015-12-02
Room: 150
From: 13:00
To: 14:00
The information will vary with each request, but I was wondering if anyone had any idea on how to capture the unique strings that will come through so that I can keep a log of the requests that is much faster than the current manual entry and double-checks?
As requested in follow up, the following code splits the message body into individual lines of information. A couple of notes: I copied your message exactly from your post, then searched for "Notice of NEW Room Request". Needless to say, this string should always start the block of information that you need. If it varies, then we have to account for the type of messages that may come through. Also, you may have to test how your message body breaks up individual lines. When I copied and pasted your message into Excel, each line break was 2 line feeds (Chr(10) in VBA). In some cases, it may be only one line feed. Or it can be a Carriage Return (Chr(13)), or even both.
Without further ado, see the code below and let us know of questions.
Sub SplitBody()
Dim sBody As String
Dim sBodyLines() As String
sBody = Range("A1").Value
sBodyLines() = Split(Mid(sBody, InStr(sBody, "Notice of NEW Room Request"), Len(sBody)), Chr(10) & Chr(10))
For i = LBound(sBodyLines) To UBound(sBodyLines)
MsgBox (sBodyLines(i))
Next i
End Sub
Below is an example connecting to an Outlook session, navigating to the default Inbox, then looping through items and adding unread emails to the spreadsheet. See if you can modify the code to your needs, and post back if specific help is needed.
Sub LinkToOutlook()
Dim olApp As Object
Dim olNS As Object
Dim olFolderInbox As Object
Dim rOutput As Range
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.getNamespace("MAPI")
Set olFolderInbox = olNS.GetDefaultFolder(6) 'Gets the default inbox folder
Set rOutput = Sheet1.Range("A1")
For Each itm In olFolderInbox.items
If itm.unread = True Then 'check if it has already been read
rOutput.Value = itm.body
Set rOutput = rOutput.Offset(1)
End If
Next itm
End Sub
Alternatively, you can write code in Outlook directly that looks for new mail arrival, and from there, you can test if it meets your criteria, and if it does, it can write to Excel. Here's a link to get you started. Post back for added help.
Using VBA to read new Outlook Email?

outlook "To Do" items into Excel using VBA

First off, I'm new to VBA, with about 20 hours of training.
I'm trying to export items from Outlook 2010 to Excel 2010. I want to grab all the unfinished "To Do" items from Outlook and throw them into Excel with one item per row, and columns for item parameters (like Subject, Due Date, attachments, etc.).
Here's the first pass that actually does what I explained, and imports only tasks (tasks are a subset of all to do items, from what I understand) and their Subject/Due Date:
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
End Function
Sub getOlTasks()
Dim olApp As Object ' Outlook.Application
Dim olnameSpace As Object ' Outlook.Namespace
Dim taskFolder As Object ' Outlook.MAPIFolder
Dim tasks As Object ' Outlook.Items
Dim tsk As Object
Set olApp = GetOutlookApp
Set olnameSpace = olApp.GetNamespace("MAPI")
Set taskFolder = olnameSpace.GetDefaultFolder(13) 'olFolderTasks is folder# 13, apparently
Set tasks = taskFolder.Items
For x = 1 To tasks.Count
Set tsk = tasks.Item(x)
Sheet1.Cells(1, 1).Activate
Do While IsEmpty(ActiveCell) = False
Selection.Offset(1, 0).Activate
Loop
'Fill in Data
If Not tsk.Complete Then
ActiveCell.Value = tsk.Subject
Selection.Offset(0, 1).Activate
ActiveCell.Value = tsk.DueDate
Selection.Offset(1, -1).Activate
End If
Next x
End Sub
I tried to do this with only "tasks" items, everything was going smoothly until I realized that tasks can't have attachments. When I have an email w/attachment that I turn into a task, I lose the attachment. Apparently what I need to do is import all "To Do items", rather than just tasks.
So My questions are:
1) What folder number is olFolderToDo? I have seen people run code like:
Set taskFolder = olnameSpace.GetDefaultFolder(olFolderTasks) 'rather than GetDefaultFolder(13)
which would lead me to believe I should be able to just use olFolderToDo, but when I try to use the name of the folder in my first example rather than the number, I get an invalid argument runtime error. If anyone knows why, I'd be interested to know.
2) How would I go about importing an attachment from an email to a specific cell in excel?
See OlDefaultFolders Enumeration (Outlook)
Name Value Description
olFolderToDo 28 The To Do folder.

Resources