Frage Entwicklung VB for Applications

gelöst öffentliche Ordner per Skript in Outlook hinzufügen

Const olPublicFoldersAllPublicFolders = 18 

Dim olkApp, olkSes, olkFolder, foldersArr 

Set olkApp = CreateObject("Outlook.Application") 

Set olkSes = olkApp.GetNameSpace("MAPI") 

Set foldersArr = CreateObject("System.Collections.ArrayList") 

'Change the profile name on the next line' 

olkSes.Logon olkApp.DefaultProfileName 

On Error Resume Next 

' public folders 

foldersArr.Add "Gemeinsame Kontakte" 

For Each folderStr In foldersArr 

	'Add Public Folder to Favorites 

	'Public Folders 

	Set olkFolder = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders) 

	'SubFolders 

	arrFolders = Split(folderStr, "\") 

    For Each varFolder In arrFolders 

		Set olkFolder = olkFolder.Folders(varFolder) 

	Next 

	olkFolder.AddToPFFavorites 

Next 

olkSes.Logoff 

Set olkApp = Nothing 

Set olkSes = Nothing 

Set olkFolder = Nothing 

WScript.Quit 

Sub AddFavoriteFolder(olkFolder) 

    ' Purpose: Add a folder to Favorite Folders.' 

    ' Written: 5/2/2009' 

    ' Author:  BlueDevilFan' 

    ' Outlook: 2007' 

    Const olModuleMail = 0 

    Const olFavoriteFoldersGroup = 4 

        Dim olkPane, olkModule, olkGroup 

    Set olkPane = olkApp.ActiveExplorer.NavigationPane 

    Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail) 

    Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup) 

    olkGroup.NavigationFolders.Add olkFolder 

    Set olkPane = Nothing 

    Set olkModule = Nothing 

    Set olkGroup = Nothing 

End Sub