AW: Auslesen eines Outlook-Suchordners
20.01.2017 13:22:06
firmus
Hallo Philipp,
probier das mal, habe ich mir durchgetested bis es klappte.
Option Explicit
'===========================================================================================
' Diese Routine entnimmt den "Query-Server-entry" aus den Searchfoldern des Servers und zeigt ihn an.
' per CTRL-SHIFT-"F" kann dann das allgemeine Searchfenster hier aufgesetzt werden.
'===========================================================================================
Sub OLU50_SearchFolders()
Dim colStores As Outlook.Stores 'PST-files: Name + Disk-location
Dim oStore As Outlook.Store
Dim oSearchFolders As Outlook.Folders
Dim oFolder As Outlook.Folder
Dim olu50DBUG As Long
Dim test As Variant
Dim i As Long, xL1 As Long, xL2 As Long, xL3 As Long, xL4 As Long, xL5 As Long
On Error Resume Next
On Error GoTo 0
olu50DBUG = 1 'debug schalter
Set colStores = Application.Session.Stores
'GoTo nodebug01
test = ""
For i = 1 To colStores.Count
test = test & Chr(10) & i & " " & colStores(i).DisplayName
'===> Suchkriterium anpassen:
If colStores(i).DisplayName = "Firmus.Nachname@domain.com" Then xL1 = i 'Outlook.STORE _
suchen (Exchange-Account or PSTfiles)
Next i
If olu50DBUG = 0 Then GoTo nodebug01
MsgBox test
i = i
nodebug01:
If xL1 = 0 Then xL1 = 2 'Kein passender Store gefunden, dann Default auf Store 1 setzen
Set oStore = colStores(xL1)
Set oSearchFolders = oStore.GetSearchFolders 'pull out the _
SearchFolders
xL2 = 0
test = "Begrenzung vorne: "
For i = 1 To oSearchFolders.Count
test = test & Chr(10) & i & " " & oSearchFolders(i).Name 'FolderPath
If xL2 = 0 And InStr(1, oSearchFolders(i).Name, "_Query_SERVER_") 0 Then xL2 = i ' _
searchfolder suchen
Next i
If olu50DBUG = 0 Then GoTo nodebug02
test = test & " :Begrenzung hinten"
MsgBox test
i = i
nodebug02:
If xL2 = 0 Then xL2 = 1 'Kein passender Searchfolder gefunden, dann Default auf _
searchfolder 1 setzen
oSearchFolders(xL2).Display 'Variante 1
Set oFolder = oSearchFolders(xL2)
oFolder.Display
'https://msdn.microsoft.com/en-us/library/office/ff866933.aspx for more details
End Sub
Gruss,
Firmus