Kategorien exportieren und importieren

PST-Dateien in Outlook® sind nicht so robust, wie es sich der Anwender wünschen würde und gehen deshalb schon einmal kaputt, bzw. bekommen Fehler (Die Messaging-Programmschnittstelle hat einen unbekannten Fehler zurückgeliefert).

Die Folge davon ist teilweiser, bzw. vollständiger Datenverlust. Solange "nur" Fehler in einer Datendatei vorhanden sind (man spricht hierbei auch von einer "korrupten" Datei), können diese gegebenenfalls wieder mit scanpst.exe (Posteingangsreparatur) repariert werden. Jedoch ist zu empfehlen, spätestens nach einer Reparatur eine neue PST-Datei anzulegen und die Daten dorthinein zu kopieren. Dazu eignet sich am besten CopyPst, das auch anstelle der Posteingangsreparatur verwendet werden kann.

Für Anwender ab Outlook® 2007 ergibt sich hierdurch ein Problem: Die Kategorien sind seit Outlook® 2007 nicht mehr in der Registrierung gespeichert, sondern in der Standard-PST-Datei. D. h. die benutzerdefinierten Kategorien gehen bei einer Kopieraktion verloren.

Wenn Sie nur wenige Kategorien haben, so ist das nicht so tragisch, da diese manuell wieder angelegt werden können. Für Benutzer mit einem umfangreichen Kategorienmanagement bedeutet das aber unter Umständen einen erheblichen Zeitaufwand.

Am Einfachsten lösen Sie das Problem mit dem Category Manager von Michael Bauer, der Ihnen die Arbeit mit Ihren Kategorien erleichtert und neben der Ex-/Import-Möglichkeit viele weitere, nützliche Funktionen bereitstellt.

Wer die Arbeit nicht scheut, der kann auch mit den unten stehenden Makros seine Kategorien übertragen. Sie sind in 2 Hauptprogrammteile unterteilt (ExportCategories und ImportCategories). Mit ExportCategories werden alle Kategorien ab Outlook® 2007 in eine Textdatei geschrieben und mit ImportCategories wieder zurückimportiert.

Analog dazu können Sie auch die Kategorieliste von Outlook® 2002 und Outlook® 2003 mit dem Makro Export200XCategories in eine Textdatei schreiben und dann auf einem System ab Outlook® 2007 wieder importieren. Wenn Sie nur mit einer Version ab 2007 arbeiten, können Sie die beiden Prozeduren Export200XCategories und RegRead weglassen (ebenso die API-Deklarationen).

Um eine Kategorieliste in Outlook® ab Version 2007 von einer Outlook®-Installation zu einer anderen zu übertragen, gehen Sie bitte wie folgt vor:

1. Kategorieliste exportieren: Makro ExportCategories aufrufen (z. B. mit Alt+F8)
2. Neue Datendatei anlegen
   Outlook® 2007: Datei -> Neu -> Outlook-Datendatei
   Ab Outlook® 2010: Datei -> Kontoeinstellungen -> Kontoeinstellungen... -> Datendateien -> Hinzufügen...
3. Daten in die neue Datei kopieren (z. B. mit CopyPst)
4. Neue PST-Datei zur Standard-PST machen
   Outlook® 2007: Extras -> Kontoeinstellungen -> Datendateien -> Neue Datei auswählen -> Als Standard festlegen
   Ab Outlook® 2010: Datei -> Kontoeinstellungen -> Kontoeinstellungen... -> Datendateien -> Neue Datei auswählen -> Als Standard festlegen
5. Outlook® neu starten
6. Kategorieliste importieren (ImportCategories)

Sie können mit dem Code auch eine Kategorieliste von PC A nach PC B übertragen. Achten Sie nur darauf, dass die Textdatei im gleichen Verzeichnis liegt, das Sie in der Konstanten CATFILE festlegen können, bzw. ändern Sie die Konstante auf dem Ziel-PC entsprechend ab. Wenn Sie mit Windows® XP arbeiten, setzen Sie bitte ein Hochkomma vor Private Const CATFILE... bei Vista® / 7 und löschen das selbige in der XP-Zeile. Selbstverständlich können Sie ein beliebiges Verzeichnis verwenden. Sie müssen nur darauf achten, dass Sie dort Schreibrechte haben.

Den Code bitte in ein neues Modul kopieren (Einfügen -> Modul im VBA-Editor). Zur Verwendung dieses Beispiels beachten Sie bitte die wichtigen Hinweise, sowie den Workshop VBA in Outlook® verwenden.

Für Outlook® 2002, Outlook® 2003, Outlook® 2007, Outlook® 2010

Option Explicit
 
'-------------------------------------------------------------------------
' API-Deklarationen zum Lesen von Binär-Werten aus der Registrierung
' Nur für Outlook 2002/2003 erforderlich
'-------------------------------------------------------------------------
Private Const KEY_READ As Long = &H20019
Private Const HKEY_CURRENT_USER As Long = &H80000001
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
        "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
        Long) As Long
 
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
        "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
        ByVal lpReserved As Long, lpType As Long, lpData As Any, _
        lpcbData As Long) As Long
 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
 
'-------------------------------------------------------------------------
' Datei zum Speichern und Wiederherstellen der Kategorien
'-------------------------------------------------------------------------
' XP:
'Private Const CATFILE As String = _
    "C:\Dokumente und Einstellungen\All Users\Dokumente\CategoriesTransfer.txt"
' Vista / 7:
Private Const CATFILE As String = _
    "C:\Users\Public\Documents\CategoriesTransfer.txt"
 
Public Sub ExportCategories()
 
    '=====================================================================
    ' Exportiert alle Kategorien aus der Standard-PST-Datei ab Outlook® 2007
    ' in eine Textdatei
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    Dim objCategories As Object
    Dim objCategory As Object
    Dim lngFF As Long
 
    '---------------------------------------------------------------------
    ' Eventuell bereits vorhandene Export-Datei löschen
    '---------------------------------------------------------------------
    If Dir(CATFILE) <> "" Then Call Kill(CATFILE)
 
    '---------------------------------------------------------------------
    ' Freie Dateinummer ermitteln
    '---------------------------------------------------------------------
    lngFF = FreeFile
 
    '---------------------------------------------------------------------
    ' Export-Datei schreibend öffnen
    '---------------------------------------------------------------------
    Open CATFILE For Output As #lngFF
 
    '---------------------------------------------------------------------
    ' Verweis auf Kategorien-Objekt setzen
    '---------------------------------------------------------------------
    Set objCategories = Outlook.GetNamespace("Mapi").Categories
 
    '---------------------------------------------------------------------
    ' Alle Kategorien bearbeiten
    '---------------------------------------------------------------------
    For Each objCategory In objCategories
 
        With objCategory
 
            '-------------------------------------------------------------
            ' Haupteigenschaften in Export-Datei schreiben (Name, Farbe
            ' und Tastaturzugriff)
            '-------------------------------------------------------------
            Print #lngFF, .Name & ";" & .Color & ";" & .ShortcutKey
 
        End With
 
    Next
 
    '---------------------------------------------------------------------
    ' Export-Datei wieder schliessen
    '---------------------------------------------------------------------
    Close #lngFF
 
    '---------------------------------------------------------------------
    ' Meldung an Benutzer ausgeben
    '---------------------------------------------------------------------
    MsgBox "Exportierte Kategorien: " & objCategories.Count _
        , vbInformation + vbOKOnly
 
    '---------------------------------------------------------------------
    ' Objekte löschen
    '---------------------------------------------------------------------
    Set objCategories = Nothing
    Set objCategory = Nothing
 
End Sub
 
Public Sub ImportCategories()
 
    '=====================================================================
    ' Importiert Kategorien aus einer Textdatei (ab Outlook® 2007)
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    Dim objCategories As Object
    Dim strCategory As String
    Dim aryCategory() As String
    Dim lngFF As Long
    Dim lngCategories As Long
 
    '---------------------------------------------------------------------
    ' Verweis auf Kategorien-Objekt setzen
    '---------------------------------------------------------------------
    Set objCategories = Outlook.GetNamespace("Mapi").Categories
 
    '---------------------------------------------------------------------
    ' Freie Dateinummer ermitteln
    '---------------------------------------------------------------------
    lngFF = FreeFile
 
    '---------------------------------------------------------------------
    ' Import-Datei nicht vorhanden?
    '---------------------------------------------------------------------
    If Dir(CATFILE) = "" Then
        MsgBox "Die Importdatei """ & CATFILE & """ wurde nicht gefunden." _
            , vbCritical + vbOKOnly
        GoTo ExitProc
    End If
 
    '---------------------------------------------------------------------
    ' Import-Datei zum Lesen öffnen
    '---------------------------------------------------------------------
    Open CATFILE For Input As #lngFF
 
    '---------------------------------------------------------------------
    ' Import-Datei abarbeiten
    '---------------------------------------------------------------------
    Do While Not EOF(lngFF)
 
        '-----------------------------------------------------------------
        ' 1 Zeile der Import-Datei einlesen
        '-----------------------------------------------------------------
        Line Input #lngFF, strCategory
 
        '-----------------------------------------------------------------
        ' Zeileninhalt in ein Feld laden
        '-----------------------------------------------------------------
        aryCategory() = Split(strCategory, ";")
 
        '-----------------------------------------------------------------
        ' Prüfen, ob die Kategorie schon vorhanden ist (0=Name)
        '-----------------------------------------------------------------
        If Not CategoryExists(aryCategory(0)) Then
 
            '-------------------------------------------------------------
            ' Anzahl importierter Kategorien erhöhen
            '-------------------------------------------------------------
            lngCategories = lngCategories + 1
 
            '-------------------------------------------------------------
            ' Kategorie importieren (0=Name, 1=Farbe, 2=Tastaturzugriff)
            '-------------------------------------------------------------
            objCategories.Add aryCategory(0), aryCategory(1), aryCategory(2)
 
        End If
 
    Loop
 
    '---------------------------------------------------------------------
    ' Import-Datei wieder schliessen
    '---------------------------------------------------------------------
    Close #lngFF
 
    '---------------------------------------------------------------------
    ' Meldung an Benutzer ausgeben
    '---------------------------------------------------------------------
    If MsgBox("Importierte Kategorien: " & lngCategories & vbCrLf & _
        vbCrLf & "Importdatei jetzt löschen?", vbInformation _
        + vbYesNo + vbDefaultButton2) = vbYes Then Call Kill(CATFILE)
 
ExitProc:
 
    '---------------------------------------------------------------------
    ' Objekte löschen
    '---------------------------------------------------------------------
    Set objCategories = Nothing
 
End Sub
 
Private Function CategoryExists(ByVal strName As String) As Boolean
 
    '=====================================================================
    ' Prüft, ob die Kategorie "strName" schon vorhanden ist
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    Dim objCategories As Object
    Dim objCategory As Object
 
    '---------------------------------------------------------------------
    ' Verweis auf Kategorien-Objekt setzen
    '---------------------------------------------------------------------
    Set objCategories = Outlook.GetNamespace("Mapi").Categories
 
    '---------------------------------------------------------------------
    ' Alle Kategorien durchlaufen
    '---------------------------------------------------------------------
    For Each objCategory In objCategories
 
        '-----------------------------------------------------------------
        ' Kategoriename schon vorhanden?
        '-----------------------------------------------------------------
        If objCategory.Name = strName Then
            CategoryExists = True
            Exit For
        End If
 
    Next
 
    '---------------------------------------------------------------------
    ' Objekte löschen
    '---------------------------------------------------------------------
    Set objCategories = Nothing
    Set objCategory = Nothing
 
End Function
 
Public Sub Export200XCategories()
 
    '=====================================================================
    ' Schreibt alle Kategorien aus der Registrierung in eine Textdatei.
    ' Nur für Outlook 2002/2003 erforderlich
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    Dim aryCategories() As String
    Dim strMasterList As String
    Dim strCategory As String
    Dim strVer As String
    Dim strRegKey As String
    Dim lngIndex As Long
    Dim lngFF As Long
 
    '---------------------------------------------------------------------
    ' Eventuell bereits vorhandene Datei löschen
    '---------------------------------------------------------------------
    If Dir(CATFILE) <> "" Then Call Kill(CATFILE)
 
    '---------------------------------------------------------------------
    ' Freie Dateinummer ermitteln
    '---------------------------------------------------------------------
    lngFF = FreeFile
 
    '---------------------------------------------------------------------
    ' Datei schreibend öffnen
    '---------------------------------------------------------------------
    Open CATFILE For Output As #lngFF
 
    '---------------------------------------------------------------------
    ' Outlook®-Version ermitteln
    '---------------------------------------------------------------------
    Select Case Left(Outlook.Version, 2)
        Case "10": strVer = "10.0"   ' Outlook® 2002
        Case "11": strVer = "11.0"   ' Outlook® 2003
    End Select
 
    '---------------------------------------------------------------------
    ' Registrierungsschlüssel zusammensetzen
    '---------------------------------------------------------------------
    strRegKey = "Software\Microsoft\Office\" & strVer & "\Outlook\Categories"
 
    '---------------------------------------------------------------------
    ' Hauptkategorieliste aus Registrierung lesen
    '---------------------------------------------------------------------
    strMasterList = RegRead(strRegKey)
 
    '---------------------------------------------------------------------
    ' Hauptkategorieliste in ein Feld laden
    '---------------------------------------------------------------------
    aryCategories() = Split(strMasterList, ";")
 
    '---------------------------------------------------------------------
    ' Alle Kategorien in die Textdatei schreiben
    '---------------------------------------------------------------------
    For lngIndex = 0 To UBound(aryCategories())
 
        If Asc(aryCategories(lngIndex)) <> 0 Then
 
            '-------------------------------------------------------------
            ' Name wird in die Datei geschrieben. -1 = Keine Farbe festlegen
            ' (macht Outlook beim Importieren). 0 = Kein Tastaturzugriff.
            '-------------------------------------------------------------
            Print #lngFF, aryCategories(lngIndex) & ";-1;0"
 
        End If
 
    Next
 
    '---------------------------------------------------------------------
    ' Textdatei wieder schliessen
    '---------------------------------------------------------------------
    Close #lngFF
 
    '---------------------------------------------------------------------
    ' Meldung an Benutzer ausgeben
    '---------------------------------------------------------------------
    MsgBox "Exportierte Kategorien: " & UBound(aryCategories()) + 1 _
        , vbInformation + vbOKOnly
 
    '---------------------------------------------------------------------
    ' Objekte löschen
    '---------------------------------------------------------------------
    Erase aryCategories()
 
End Sub
 
Private Function RegRead(ByVal strSection As String) As String
 
    '=====================================================================
    ' Liest Binär-Daten aus der Registry
    ' Nur für Outlook 2002/2003 erforderlich
    ' (c) Peter Marchert - http://www.outlook-stuff.com
    ' 2008-11-21 Version 1.0.0
    '=====================================================================
 
    Dim lngHandle As Long
    Dim lngReturn As Long
    Dim bytData() As Byte
    Dim lngDataType As Long
    Dim lngBufferSize As Long
 
    On Error Resume Next
 
    '---------------------------------------------------------------------
    ' Registryschlüssel öffnen
    '---------------------------------------------------------------------
    Call RegOpenKeyEx(HKEY_CURRENT_USER, strSection, 0&, KEY_READ, lngHandle)
 
    '---------------------------------------------------------------------
    ' Datengröße bestimmen
    '---------------------------------------------------------------------
    Call RegQueryValueEx(lngHandle, "MasterList", 0&, 3, ByVal 0&, lngBufferSize)
 
    '---------------------------------------------------------------------
    ' Daten lesen
    '---------------------------------------------------------------------
    ReDim bytData(lngBufferSize - 1) As Byte
    Call RegQueryValueEx(lngHandle, "MasterList", 0&, 3, bytData(0), lngBufferSize)
 
    '---------------------------------------------------------------------
    ' Daten als String zurückgeben
    '---------------------------------------------------------------------
    RegRead = CStr(bytData)
 
    '---------------------------------------------------------------------
    ' Schlüssel wieder schliessen
    '---------------------------------------------------------------------
    Call RegCloseKey(lngHandle)
 
End Function