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.
Mit den unten stehenden Makros lassen sich die Kategorien von einer Installation in eine andere ü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:
- Kategorieliste exportieren: Makro ExportCategories aufrufen (z. B. mit Alt+F8)
-
Neue Datendatei anlegen
Outlook® 2007: Datei -> Neu -> Outlook-Datendatei
Ab Outlook® 2010: Datei -> Kontoeinstellungen -> Kontoeinstellungen... -> Datendateien -> Hinzufügen...
- Daten in die neue Datei kopieren (z. B. mit CopyPst)
-
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
- Outlook® neu starten
- 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.
Ab Outlook® 2002
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 ' 2012-11-28 Version 1.1.0 ' 2008-11-21 Version 1.0.0 '===================================================================== Dim objCategories As Outlook.Categories Dim vbResult As VbMsgBoxResult 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 '--------------------------------------------------------------------- ' Sind Kategorien vorhanden? '--------------------------------------------------------------------- If objCategories.Count > 0 Then '----------------------------------------------------------------- ' Vorhandene Kategorien löschen? '----------------------------------------------------------------- vbResult = MsgBox("Sollen die vorhandenen Kategorien gelöscht werden?", _ vbQuestion + vbYesNoCancel + vbDefaultButton2, "Kategorien importieren") '----------------------------------------------------------------- ' Antwort auswerten '----------------------------------------------------------------- Select Case vbResult Case vbYes: If Not DeleteCategories(objCategories) Then GoTo ExitProc Case vbNo: ' Nichts machen Case vbCancel: GoTo ExitProc End Select End If '--------------------------------------------------------------------- ' 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 DeleteCategories(ByVal objCategories As Outlook.Categories) As Boolean '===================================================================== ' Löscht vorhandene Kategorien ' Ab Outlook 2007 ' (c) Peter Marchert - http://www.outlook-stuff.com ' 2012-11-28 Version 1.0.0 '===================================================================== Dim intCategories As Integer Dim intIndex As Integer Dim intDeleted As Integer Dim intErrors As Integer On Error Resume Next '--------------------------------------------------------------------- ' Anzahl Kategorien ermitteln '--------------------------------------------------------------------- intCategories = objCategories.Count '--------------------------------------------------------------------- ' Alle Kategorien durchlaufen und löschen '--------------------------------------------------------------------- For intIndex = intCategories To 1 Step -1 '----------------------------------------------------------------- ' Fehler zurücksetzen '----------------------------------------------------------------- Err.Clear '----------------------------------------------------------------- ' Kategorie löschen '----------------------------------------------------------------- Call objCategories.Remove(intIndex) '----------------------------------------------------------------- ' OK? '----------------------------------------------------------------- If Err.Number = 0 Then intDeleted = intDeleted + 1 Else intErrors = intErrors + 1 End If Next '--------------------------------------------------------------------- ' Meldung an Benutzer '--------------------------------------------------------------------- If MsgBox("Kategorien vorher: " & intCategories & vbCrLf & vbCrLf & _ "Gelöscht: " & intDeleted & vbCrLf & _ "Fehler: " & intErrors & vbCrLf & vbCrLf & _ "Kategorien nachher: " & objCategories.Count, _ vbInformation + vbOKCancel, "Kategorien löschen") = vbOK Then DeleteCategories = True Else DeleteCategories = False End If '--------------------------------------------------------------------- ' Objekte löschen '--------------------------------------------------------------------- Set objCategories = Nothing End Function 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