automate Outlook 2013 with VB.NET OR VBSCRIPT

I need to automate two shared Calenders one called lab and the other called main conference room. So the goal is to write a script or .net exe to launch outlook with a generic account testcenter@companyname.com. Here is a visual of what needs to be loaded
The goal !!The goal !!
Dim objApp 'As Outlook.Application
Dim objNS
Dim objFolder
Dim strName(2) 'Array size
Dim objDummy
Dim objRecip
Dim calendar

'Names for resource accounts (alias)

strName(0) = "Lab"
strName(1) = "Main Conference Room"

Const olMailItem = 0
Const olFolderCalendar = 9

'This section will start outlook.exe - wait 9 seconds - Changes the Focus to Outlook - Wait another second
'then add calendars
set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "outlook"
WScript.Sleep 9000
WshShell.AppActivate "Outlook"
WScript.Sleep 1000
 For Each calendar In strName

    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = OpenOutlookFolder("Mailbox - \\testcalendar@servicechamp.com\Calendars\Room List\Lab")
 Set Application.ActiveExplorer.CurrentFolder = CalendarFolder 
      
    Next

    Set GetOtherUserCalendar = objFolder
    Set objApp = Nothing
    Set objNS = Nothing
   ' Set objFolder = Nothing
'For Each Next Loop while adds each calendar from strName(array) to the users Shared Calendars
Function OpenOutlookFolder(strFolderPath)
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders, varFolder, bolBeyondRoot
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = olkSes.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Open in new window


Here is me just trying to start in VB.Net
Imports Microsoft.Office.Interop.Outlook
Imports Microsoft.Office.Interop

Public Class Form1
    Public Sub Test()
        Dim objOutlook As Outlook._Application
        objOutlook = New Outlook.Application()
        Dim objNS As Outlook._NameSpace = objOutlook.Session
        Dim objRecipient As Outlook.Recipient = _
            objNS.CreateRecipient("testcenter@companyname.com")
        If objRecipient.Resolve Then
            Dim objFolder As Outlook.MAPIFolder = _
                objNS.GetSharedDefaultFolder(objRecipient, _
                Outlook.OlDefaultFolders.olFolderCalendar)
            Console.Write(objFolder.Name)
        Else
            Console.Write("Recipient could not be resolved.")
        End If
    End Sub
End Class

Open in new window


I pay for EE but it appears EE is going in a different direction where you pay a fee for membership and still have to pay a tech for their Service nice business move but if that's the case I'm done outta EE for good. I got a serious issue and for years someone from EE would step in and save the day.
powerztomAsked:
Who is Participating?
 
KimputerCommented:
Stupid, I should have used your first attached pic to fill in the blanks of the code. I'll try again:

Sub SelectCalendars()
    Dim objPane As Outlook.NavigationPane
    Dim objModule As Outlook.CalendarModule
    Dim objGroup As Outlook.NavigationGroup
    Dim objNavFolder As Outlook.NavigationFolder
    Dim objCalendar As Folder
    Dim objFolder As Folder
    
    Dim i As Integer
    
    Set Application.ActiveExplorer.CurrentFolder = Session.GetDefaultFolder(olFolderCalendar)
    DoEvents
    
    Set objCalendar = Session.GetDefaultFolder(olFolderCalendar)
    Set objPane = Application.ActiveExplorer.NavigationPane
    Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
    
    With objModule.NavigationGroups
        'Set objGroup = .GetDefaultNavigationGroup(olMyFoldersGroup)

    ' To use a different group
        Set objGroup = .Item("Rooms")
    End With

    For i = 1 To objGroup.NavigationFolders.Count
        Set objNavFolder = objGroup.NavigationFolders.Item(i)
        
                MsgBox objNavFolder.Displayname
        'next line depends on the message box
if (objNavFolder.Displayname ="Lab") or objNavFolder.Displayname = "Main Conference Room" then
                objNavFolder.IsSelected = True
                objNavFolder.IsSideBySide = True
else
                   objNavFolder.IsSelected = false
end if

                'objNavFolder.IsSelected = True
                'objNavFolder.IsSideBySide = True
        
                'objNavFolder.IsSelected = False
        
    Next

    Set objPane = Nothing
    Set objModule = Nothing
    Set objGroup = Nothing
    Set objNavFolder = Nothing
    Set objCalendar = Nothing
    Set objFolder = Nothing
End Sub

Open in new window


If it works, and needs to work on MORE PC's, then we need to check how it behaves for those PC's (probably won't work, since the Rooms group has to be populated first, probably with my second piece of code posted earlier.
0
 
KimputerCommented:
First of all, paying a tech for their service (Gigs, Live) is ONLY necessary if it's a bigger project.
If you wish to continue as it has been for years (just questions and answers), it's working as it is.

Now onto the solution (not fully yet, just step by step), here's some VBA sampling (which you can test in VB.net):

Sub SelectCalendars()
    Dim objPane As Outlook.NavigationPane
    Dim objModule As Outlook.CalendarModule
    Dim objGroup As Outlook.NavigationGroup
    Dim objNavFolder As Outlook.NavigationFolder
    Dim objCalendar As Folder
    Dim objFolder As Folder
    
    Dim i As Integer
    
    Set Application.ActiveExplorer.CurrentFolder = Session.GetDefaultFolder(olFolderCalendar)
    DoEvents
    
    Set objCalendar = Session.GetDefaultFolder(olFolderCalendar)
    Set objPane = Application.ActiveExplorer.NavigationPane
    Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
    
    With objModule.NavigationGroups
        Set objGroup = .GetDefaultNavigationGroup(olMyFoldersGroup)

    ' To use a different group
        'Set objGroup = .Item("Shared Calendars")
    End With

    For i = 1 To objGroup.NavigationFolders.Count
        Set objNavFolder = objGroup.NavigationFolders.Item(i)
        
        MsgBox objNavFolder.Folder.FolderPath
        MsgBox objNavFolder.Displayname
        
                'objNavFolder.IsSelected = True
                'objNavFolder.IsSideBySide = True
        
                'objNavFolder.IsSelected = False
        
    Next

    Set objPane = Nothing
    Set objModule = Nothing
    Set objGroup = Nothing
    Set objNavFolder = Nothing
    Set objCalendar = Nothing
    Set objFolder = Nothing
End Sub

Open in new window


Need to figure out how to best identify the folders (EntryID seems the most reliable, but Displayname might also work if nothing weird is being done with the calendars), and in which group they belong (or if you don't know, you have to run code multiple times for each group).
Then there's the issue if it's not listed. You have to force a one time connection:

  Dim NS As Outlook.NameSpace
  Dim objOwner As Outlook.Recipient
   
  Set NS = Application.GetNamespace("MAPI")
  Set objOwner = NS.CreateRecipient("maryc")
    objOwner.Resolve
       
 If objOwner.Resolved Then
   'MsgBox objOwner.Name
 Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
 End If

Open in new window


You should run this after the displaying didn't pick up any (means you need a flag system), or you could run it at the start of the code (no flag needed then).
Test on 2 or 3 PC's, see it's it's reliably always grouping at the My Calendars or Shared Calendars group or not. Then see if the displayname is reliable or not.

Remember, this isn't working code, it's just to help you along a bit. After some feedback, we may finalize the working code.
1
 
powerztomAuthor Commented:
Kimputer Thanks your first code you posted it almost gets me to there I mean it brings up the email account Msgbox then displays Msgbox Calendar then navigates to calendar Now this part
 With objModule.NavigationGroups
        Set objGroup = .GetDefaultNavigationGroup(olMyFoldersGroup)

    ' To use a different group
        'Set objGroup = .Item("Room List")
    End With

Open in new window

When I uncheck this line  'Set objGroup = .Item("Room List")
I get an error message see screenshot.Error message
Sorry about getting angry with the site So Your code almost gets me there I'm gonna be busy I need this should I give you the Points and reopen a new ticket cause with your code I can see progress. Thanks Bro
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
powerztomAuthor Commented:
Room List is the folder that has Lab and Main conference room calendars that this guy is asking for I'm a avg to intermediate Vb Coder so just trying to get this guy out of my hair.
0
 
powerztomAuthor Commented:
Kimputer thanks for your help the company is going to do this the manual way cause they're complaining when is this going to happen They actually threw this in my lap 2 days ago I know this could be solved but just need more time then they are giving to me. just wanted to thank you for reaching out and helping me. and it was this line
 Set objGroup = .Item("Rooms") still cause and error. Man I thought I was good at vb Scripting then you get a non Computer person asking for something to happen that is not easy. Thank You
0
 
powerztomAuthor Commented:
Kimputer thanks for your help the company is going to do this the manual way cause they're complaining when is this going to happen They actually threw this in my lap 2 days ago I know this could be solved but just need more time then they are giving to me. just wanted to thank you for reaching out and helping me. and it was this line
 Set objGroup = .Item("Rooms") still cause and error. Man I thought I was good at vb Scripting then you get a non Computer person asking for something to happen that is not easy. Thank You
0
 
powerztomAuthor Commented:
Kimputer thanks for your help the company is going to do this the manual way cause they're complaining when is this going to happen They actually threw this in my lap 2 days ago I know this could be solved but just need more time then they are giving to me. just wanted to thank you for reaching out and helping me. and it was this line
 Set objGroup = .Item("Rooms") still cause and error. Man I thought I was good at vb Scripting then you get a non Computer person asking for something to happen that is not easy. Thank You
0
 
KimputerCommented:
Sorry I couldn't help you. That's because Rooms is the only one I didn't (and still couldn't) test yet. I think on Exchange level, it's _slightly_ different from the normal Calendar, and _slightly_ different is enough to make normal working code break.
1
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.