Migration von Benutzerdaten zur Umstellung von Windows XP zu Windows 7 2/2

Die Migration der Benutzerdaten nach einer Umstellung von Windows XP auf Windows 7 ist sehr zeitaufwendig, wie ich meinem vorherigen Blog-Post schon beschrieben habe.

Da man in der IT, Gott sei Dank, größtenteils automatisieren kann, habe ich mir diesen Umstand zur Nutze gemacht und passend zum Sicherungs-Skript, natürlich auch ein Wiederherstellungs-Skript gebaut.

Features:

• Außenstandorte werden unterstützt => wenn ein bestimmtes Default Gateway gesetzt ist, wird keine Wiederherstellung durchgeführt
• Konfigurierbares Home-Laufwerk
• Wiederherstellung nur, wenn Betriebssystem Windows7
• Wiederherstellung nur, wenn Computername ein bestimmtes Muster hat (z.B: INVW700001)
• Wiederherstellung von Ordnern
• Vorbereitung für Start/Stop von Prozessen
• Error-Handling
• Migration von OpenOffice zu LibreOffice
• Warten auf etwaige, laufende Softwarverteilung (Frontrange DSM: Niinst32.exe)
• Nach Wiederherstellung automatische Abmeldung 
• Flag bei erfolgte Wiederherstellung (in %APPDATA%)

Hier der Code:

'#####################################################

' Wiederherstellungsscript
'  Author: Oliver Skibbe oliskibbe (at) gmail.com
' Date: 2013-09-25

'#####################################################

' Constants
' Windows Version
Const Win2k = "5.0"
Const WinXP = "5.1"
Const Win2k3 = "5.2"
Const WinVista = "6.0"
Const Win7 = "6.1"
Const Win2k8 = "6.2"

' Stuff
Const Target = "INVW7"
Const HomeDrive = "Z:\"

' Objects
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objWMIService = GetObject("winmgmts:\\localhost\root\cimv2")

TargetVersion = Win7

' Get Windows Version
Set colOperatingSystem = objWMIService.ExecQuery("Select Version from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystem
 Version = objOperatingSystem.Version
Next

' Quit if target pc name is not XXX or uses other Version than Windows 7
strComputerName = WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
If InStr(1, strComputerName, Target, VbTextCompare) = 0 Then
 WScript.Quit
Else
 ' If computer name is valid, check OS version
 If Not Mid(Version,1,3) = TargetVersion Then
  WScript.Quit
 End If 
End If ' end check valid target pc


' paths
strProfileDir = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
strProgramFilesDir = WshShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
strAppDataDir = strProfileDir + "\AppData"
strLocalAppDataDir = strAppDataDir + "\Local"
strRoamingAppDataDir = strAppDataDir + "\Roaming"

' quit if restore already completed
RestoreFlag = strAppDataDir + "\Restore_done.flag"
If objFSO.FileExists(RestoreFlag) Then
 WScript.Quit
End If

' Get Default GW
Set colNetworkConfiguration = objWMIService.ExecQuery("Select DefaultIPGateway from  Win32_NetworkAdapterConfiguration Where IPEnabled = TRUE")
For Each objNetworkConfiguration in colNetworkConfiguration
 If Not IsNull(objNetworkConfiguration.DefaultIPGateway) Then 
  DefaultGateway = Join(objNetworkConfiguration.DefaultIPGateway, ",")
 End If
Next

' no restore in hannover so far
If DefaultGateway = "10.10.1.1" Then
 Wscript.Quit
End If

' sleep if dsm net install is currently running
ProcToWatch = "NIInst32.exe"
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where Name ='" & ProcToWatch & "'")
Do Until colProcesses.Count = 0
 WScript.Sleep 10000
 Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where Name ='" & ProcToWatch & "'")
Loop

' Quit if home drive is not available / writable or wrong type
CheckDrive(HomeDrive)

WshShell.Popup "Die Rück-Sicherung der eigenen Dateien wurde gestartet", 3

' Source
SourceBase = HomeDrive + "\Sicherung"
If Not objFSO.FolderExists(SourceBase) Then
 MsgBox("Es wurde keine sicherung in " + SourceBase + " gefunden!")
 WScript.Quit
End If

' Targets
TargetDesktop = strProfileDir & "\Desktop"
TargetOwnFiles = strProfileDir + "\Documents"
TargetFavorites = strProfileDir & "\Favorites"
TargetLOfficeBase = strLocalAppDataDir  + "\LibreOffice\4\user"
TargetRoamingMSOffice = strRoamingAppDataDir + "\Microsoft"
TargetLocalMSOffice = strLocalAppDataDir + "\Microsoft"

' Restore Desktop
Restore SourceBase + "\Desktop", TargetDesktop, "Desktop", "dir", False
' Restore own files
Restore SourceBase + "\Eigene Dateien", TargetOwnFiles, "Eigene Dateien", "dir", False
' Restore Favorites
Restore SourceBase + "\Favoriten", TargetFavorites, "Favoriten", "dir", False
' Restore / Migrate OpenOffice to LibreOffice
Restore SourceBase + "\OpenOffice", TargetLOfficeBase, "LibreOffice", "dir", False
' Restore AppData Local MS Office
Restore SourceBase + "\Local\MSOffice", TargetLocalMSOffice, "MS Office", "dir", False
' Restore AppData Roaming MS Office
Restore SourceBase + "\Roaming\MSOffice", TargetRoamingMSOffice, "MS Office", "dir", False

' touch restore flag
objFSO.CreateTextFile(RestoreFlag)

WshShell.Popup "Die Rück-Sicherung der eigenen Dateien wurde beendet"
' log off
WScript.Sleep 5000
WshShell.run "shutdown /l /t 0"
' End of Main

''' Functions
' control processes
Function ProcessControl(proc, state, CheckState)

 If state = "stop" Then ' stop process
  cmd = "taskkill.exe /F /IM " + proc
 Else ' start process  
  cmd = proc
 End If ' end start / stop state
 
 ExitCode = WshShell.run (cmd, 1, true)
 If CheckState = True Then
  If ExitCode > 0 Then
   MsgBox "Fehler beim " + state + " von " + proc, vbCritical
   WScript.Quit
  End If ' end exit code
 End If ' end check state
End Function

Function Restore(Source, Target, Label, PathType, Required)
  ' try to copy folder
  If PathType = "dir" Then
  
   If objFSO.FolderExists(Source) Then
    If Not objFSO.FolderExists(Target) Then
     CreateFolderRecursive Target
    End If
    objFSO.CopyFolder Source, Target
   Else
    ' If required but does not exist: Quit!
    If Required = True Then
     MsgBox("Fehler bei der Rücksicherung von " + Label)
     WScript.Quit
    End If ' End Required Output
   End If ' end check source and target folder
  ' try to copy file 
  Elseif PathType = "file" Then
   ' try to copy file, source file name and target directory  
   If objFSO.FileExists(Source) And objFSO.FolderExists(Target) Then
    objFSO.CopyFile Source, Target
   Else
    ' If required but does not exist: Quit!
    If Required = True Then
     MsgBox("Fehler bei der Rücksicherung von " + Label)
     WScript.Quit
    End If ' End Required Output
   End If ' end check source and target file   
  ' not supported 
  Else  
   MsgBox("Typ wird nicht unterstützt, wählen Sie: dir, file")
   WScript.Quit
  End If
End Function

' Check target drive
Function CheckDrive(Drive)
  
 If objFSO.DriveExists(Drive) Then
  Set DriveState = objFSO.GetDrive(Drive)  
  ' Check home drive 
  If Not DriveState.IsReady = True Then
   ErrorText = "Laufwerk " + Drive + " ist nicht erreichbar, bitte starten Sie den PC neu!"
   ErrorOccured = True
  Else 
   ' 0: unkown, 1: Removable, 2: Fixed, 3: Network, 4: CD-Rom, 5: RAM-Disk
   If Not DriveState.DriveType = 1 And Not DriveState.DriveType = 2 And Not DriveState.DriveType = 3 Then 
    ErrorText = Drive + ": ist kein gültiger Laufwerkstyp, mögliche Typen: Netzwerk, Festplatte, Wechseldatenträger"
    ErrorOccured = True
   End If ' end check valid drive type
  End If
 Else
  ErrorText = "Laufwerk " + Drive + " existiert nicht, bitte starten Sie den PC neu!"
  ErrorOccured = True
 End If ' End Drive exists
 
 If ErrorOccured = True Then
  MsgBox(ErrorText)
  WScript.Quit
 End If
End Function

Function CreateFolderRecursive(FullPath)
 arr = split(FullPath, "\")
 path = ""
 For Each dir In arr
  If path <> "" Then 
   path = path & "\"
  End If
  path = path & dir
  If Not objFSO.FolderExists(path) Then 
   objFSO.CreateFolder(path)
  End If
 Next
End Function
' EOF

Das Skript sollte angepasst, getestet und im NETLOGON Verzeichnis abgelegt werden, anschließend kann es im Login-Skript verankert werden und stellt ab diesem Zeitpunkt automatisch bei der ersten Anmeldung die Daten wieder her.

Zum Download

Bei Fragen bitte melden!

Migration von Benutzerdaten zur Umstellung von Windows XP zu Windows 7 oder wie sichere ich automatisch für BenutzerInnen lokale Daten 1/2

In einem modernen Unternehmen werden häufig serverbasierte Profile und/oder Ordnerumleitungen für die persönlichen, PC-basierten, Daten der BenutzerInnen eingesetzt.

Dieses hat den Vorteil, dass auf den lokalen PCs keine Daten vorhanden sind und somit die Gefahr des Datenverlustes bei Ausfall, Diebstahl, Elementare Gefährdungen, etc. minimiert wird.

Wenn nun allerdings der Umstieg auf Windows 7 ansteht, wird einem bei Tests sehr schnell auffallen, dass die XP Profile nicht mit den W7 Profilen gemischt werden können und man somit, bei Anmeldung an Windows 7, nur ein temporäres Profil zugewiesen bekommt bzw. im schlimmsten Fall das XP Profil zerschiesst.
Dieses Problem tritt auf, da zu einem die Registry (betrifft serverbasierte Profile) andere Einträge aufweist, sowie die Verzeichnisstruktur (z.B. Ordnerumleitungen) seit Windows Vista eine andere ist.

Kurzer Exkurs zu den beiden Möglichkeiten:

Serverbasierte Profile

Das serverbasierte Profil beinhaltet das gesamte Profil eines Benutzer-Accounts, inkl. Registry und %USERPROFILE% (genauere Informationen dazu gibt es bei Microsoft und zwar hier). Die Daten werden auf den lokalen PC geschrieben und gelesen, d.h. es findet eine Synchronisation zwischen PC und Server statt.

Vorteil(e):

• Alle Daten sind vollständig auf dem Server => Vermeidung von Datenverlusten
• Alle Daten sind vollständig auf dem Client => Offline Arbeit möglich

Nachteil(e):

• Verzögerung beim Anmelden, da das gesamte Profil vom Server heruntergeladen, also synchronisiert wird, je nach Bandbreite und Auslastung des Servers kann dieses zu unangenehmen Verzögerungen und eingeschränktem Produktionsausfall führen. Beispiel: die Anmeldung dauert 5 Minuten mit einem serverbasierten Profil und 1 Minute mit lokalem Profil, in einem Arbeitsjahr würde sich das Ganze zu 14,7 Stunden summieren und somit pro BenutzerIn zu fast 2 Tagen Produkionsausfall per anno führen würde
• Synchronisation der Daten erst bei Abmeldung, bei Ausfall des PCs sind die letzten Änderungen nicht gesichert, Abmeldung wird ebenfalls verzögert
• Höhere Grundlast auf den Servern/Storage und Netzwerk zu Stoßzeiten (Beginn, Mittagspause, Feierabend)

Ordnerumleitungen

Ordnerumleitungen können über Gruppenrichtlinien konfiguriert werden und bieten eine einfache Möglichkeit zur Umleitung von Ordnern auf andere Systeme, gerne für Ordner wie Eigene Dateien oder Desktop genutzt, damit die Anmeldezeit verringert, aber die Gefährdung durch Datenverlust dennoch minimiert.

Vorteil(e):

• Konfigurierte sind vollständig auf dem Server => Vermeidung von Datenverlusten
• Keine Verzögerung beim An- und Abmelden

 Nachteil(e):

• Höhere Grundlast auf den Servern/Storage und Netzwerk, da Live gearbeitet wird
• Keine Offline-Arbeit möglich

Da beide Lösungen jeweils Vor- und Nachteile bieten, sollte genau geprüft werden, welche von beiden genutzt oder wie beide kombiniert werden sollten.
Typisch wird das serverbasierte Profil in Kombination mit Ordnerumleitung von Desktop und Eigene Dateien genutzt, so hat man eine effiziente Lösung mit geringem Impact auf die Datensicherheit und Gesamt Performance


Zurück zum Thema, bei der Umstellung von Windows XP auf Windows 7 gibt es natürlich nicht nur die Profile/persönlichen Daten zu beachten, sondern es gilt auch Dinge zu prüfen, wie z.B.:

• Der wichtigste Punkt: Software-Kompabilität zu Windows 7, inkl. Architektur (Test durch IT, Fachabteilung)
• Upgrade der Domänen-Controller (Achtung, abhängige Authentifizierungsdienste bedenken, z.B. SSPI, NTLMv1) zur Nutzung der neuen GPO Features
• Schulung, Schulung und Schulung => erhöht Akzeptanz der Mitarbeiter, selten gilt: Neu ist immer besser ;-)
• Planung, Planung und Planung: Test, Logistik (Wie, wo, wann und durch wen wird installiert), Rollout (Etagenweise, Abteilungsweise, ...), Transparenz (Was funktioniert wie, Wann passiert was) => Akzeptanz der Mitarbeiter

In meinem Anwendungsfall kommen keine serverbasierten Profile zum Einsatz, das hat zur Folge, das Daten wie z.B. Favoriten, Wörterbücher, Signaturen (falls nicht automatisiert, siehe dazu meine vorherigen Einträge), Dokumente nur lokal auf den PCs abgelegt werden.
Es gibt nun zwei Wege um dieses "Dilema" zu lösen.
Der eine Weg ist eine organisatorische Lösung, d.h. die BenutzerInnen werden informiert, dass ab sofort alle Daten auf dem Home Laufwerk gespeichert bzw. dort hin verschoben werden sollen, der andere Weg ist eine technische Lösung in Form eines Skripts, dass diese Aufgabe selbstständig erledigt.
Um die größtmögliche Akzeptanz mit Effizienz zu kombinieren, habe ich mich für einen gemischten Weg entschieden, d.h. es gibt eine Dienstanweisung, die sagt, dass alles Zukünftige nur noch auf dem Home-Laufwerk gespeichert werden soll (+ Ordnerumleitungen), sowie zwei Skripte zur Sicherung und Wiederherstellung wurden von mir geschrieben.

Da natürlich, aus Gründen des Datenschutz, kein Zugriff auf die Home-Laufwerke der BenutzerInnen besteht, kommt keine serverbasierte Sicherung der Daten in Frage, sondern eine Lösung, die durch den Benutzer entweder manuell oder automatisch gestartet wird.

Entschieden habe ich mich für die automatische Lösung mit Hilfe des Login-Skripts, somit wird bei Login eine Sicherung der konfigurierten Pfade durchgeführt, Nachteil: die Sicherung kann unvollständig sein. Ich habe mich bewusst für das Login-Skript entschieden, da BenutzerInnen beim Herunterfahren des PCs häufig den Bildschirm als Erstes ausschalten und somit Bildschirmmeldungen nicht mehr sehen können (natürlich wäre auch eine automatisierte E-Mail aus dem Skript heraus möglich, allerdings werden diese auch gern ignoriert..)

Folgende Features unterstützt das Sicherungs-Skript (durch Anpassung der Pfade und der Version kann das Skript auch als normales Sicherungsskript bei PC-Wechsel genutzt werden!):

• Außenstandorte werden unterstützt => wenn ein bestimmtes Default Gateway gesetzt ist, wird keine Sicherung durchgeführt
• Konfigurierbares Home-Laufwerk
• Sicherung nur, wenn Betriebssystem Windows XP
• Sicherung nur, wenn Computername ein bestimmtes Muster hat (z.B: PCXP00001)
• Meldung bei Überschreitung der konfigurierbaren Größe
• Rekursive Sicherung von Ordner, bei Ausschluss von Dateien größer als X (z.B. Outlook Ordner ohne pst-file)
• Meldung, wenn Dateien in einem Ordner gefunden werden, die zu Tag X (Datum/Meldung konfigurierbar, abhängig vom Default Gateway) erledigt sein müssen
• Start/Stop von Prozessen
• Error-Handling
• Default Sicherungspfade: Desktop (250 MB), Eigene Dateien (250 MB), Outlook (pst file bis 100 MB), MS Office, OpenOffice (Textbausteine, Wörterbücher)

Hier der Code

'#####################################################

' Sicherungsscript
'  Author: Oliver Skibbe oliskibbe (at) gmail.com
' Date: 2013-09-17

'#####################################################

' Constants
' Windows Version
Const Win2k = "5.0"
Const WinXP = "5.1"
Const Win2k3 = "5.2"
Const WinVista = "6.0"
Const Win7 = "6.1"
Const Win2k8 = "6.1"

' Stuff
Const Target = "INV"
Const HomeDrive = "Z:\"

' max transferred bytes
' 100 MB
Const maxDefaultSize = 104857600
' 250 MB
Const maxDesktopSize = 262144000
Const maxOwnFilesSize = 262144000

TargetVersion = WinXP

' Objects
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objWMIService = GetObject("winmgmts:\\localhost\root\cimv2")

' Get Windows Version
Set colOperatingSystem = objWMIService.ExecQuery("Select Version from Win32_OperatingSystem")
For Each objOperatingSystem In colOperatingSystem
 Version = objOperatingSystem.Version
Next

' Get Default GW
Set colNetworkConfiguration = objWMIService.ExecQuery("Select DefaultIPGateway from  Win32_NetworkAdapterConfiguration Where IPEnabled = TRUE")
For Each objNetworkConfiguration in colNetworkConfiguration
 If Not IsNull(objNetworkConfiguration.DefaultIPGateway) Then 
  DefaultGateway = Join(objNetworkConfiguration.DefaultIPGateway, ",")
 End If
Next

' Quit if target pc name is not XXX or uses other Version than Windows 7
strComputerName = WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
If InStr(1, strComputerName, Target, VbTextCompare) = 0 Then
 WScript.Quit
Else
 ' If computer name is valid, check OS version
 If Not Mid(Version,1,3) = TargetVersion Then
  WScript.Quit
 End If 
End If ' end check valid target pc

' quit if hannover gw ip => no backup
If DefaultGateway = "10.10.1.1" Then
 Wscript.Quit
End If

' quit if Foobar town gw ip => no backup
If DefaultGateway = "10.16.1.1" Then
 Wscript.Quit
End If

' Quit if home drive is not available / writable or wrong type
CheckDrive(HomeDrive)

' Helper vars
strProgramFiles = WshShell.ExpandEnvironmentStrings("%PROGRAMFILES%")
strProfileDir = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
strAppDataDir = WshShell.ExpandEnvironmentStrings("%APPDATA%")
strLocalDir = strProfileDir + "\Lokale Einstellungen\Anwendungsdaten"

' Source dirs
SourceDesktop = strProfileDir & "\Desktop"
SourceFavorites = strProfileDir & "\Favoriten"
SourceOwnFiles = strProfileDir + "\Eigene Dateien"
SourceOOfficeBase = strAppDataDir  + "\OpenOffice.org\3\user"
SourceRoamingMSOfficeBase = strAppDataDir  + "\Microsoft"
SourceLocalMSOfficeBase = strLocalDir  + "\Microsoft"

' Target dirs
TargetBase = HomeDrive + "\Sicherung"
TargetDesktop = TargetBase + "\Desktop"
TargetOwnFiles = TargetBase + "\Eigene Dateien"
TargetFavorites = TargetBase + "\Favoriten"
TargetOOffice = TargetBase + "\OpenOffice"
TargetRoamingMSOffice = TargetBase + "\Roaming\MSOffice"
TargetLocalMSOffice = TargetBase + "\Local\MSOffice"

' create backup folder if not exists
If Not objFSO.FolderExists(TargetBase) Then
 objFSO.CreateFolder TargetBase
End If ' End check folder

WshShell.Popup "Die Sicherung der eigenen Dateien wurde gestartet", 2

'''' Desktop ''''
 BackupFolder SourceDesktop, TargetDesktop, "Desktop", maxDesktopSize, False

'''' Own files ''''
 BackupFolder SourceOwnFiles, TargetOwnFiles, "Eigene Dateien", maxOwnFilesSize, False

'''' Favorites ''''
 BackupFolder SourceFavorites, TargetFavorites, "Favoriten", maxDefaultSize, False

'''' OpenOffice ''''
 BackupFolder SourceOOfficeBase + "\autotext", TargetOOffice + "\autotext", "OOffice Textbausteine", maxDefaultSize, False
 BackupFolder SourceOOfficeBase + "\wordbook", TargetOOffice + "\wordbook", "OOffice Wörterbuch", maxDefaultSize, False
 
'''' Microsoft Office ''''
 BackupFolder SourceRoamingMSOfficeBase + "\Templates", TargetRoamingMSOffice + "\Templates", "MS Office Templates", maxDefaultSize, False
 BackupFolder SourceRoamingMSOfficeBase + "\Signatures", TargetRoamingMSOffice + "\Signatures", "MS Office Signatures", maxDefaultSize, False
 BackupFolder SourceRoamingMSOfficeBase + "\Document Building Blocks", TargetRoamingMSOffice + "\Document Building Blocks", "MS Office Textbausteine", maxDefaultSize, False

'''' Outlook folder without pst (via file size) ''''
 BackupFolderRecursiveExcludeMaxSize SourceRoamingMSOfficeBase + "\Outlook", TargetRoamingMSOffice + "\Outlook", "Outlook", maxDefaultSize, False
 BackupFolderRecursiveExcludeMaxSize SourceLocalMSOfficeBase + "\Outlook", TargetLocalMSOffice + "\Outlook", "Outlook", maxDefaultSize, False

'''' Auftragsdaten ''''
' Message if files are available (could be just in addition to a due time)
CheckFileCountInFolder "C:\Auftragsdaten\Daten", "Auftragsdaten", 1



' Target Size Output
Set objFolder = objFSO.GetFolder(TargetBase) 
' returns byte
TargetSize =  objFolder.Size

WshShell.Popup "Die Sicherung der eigenen Dateien wurde beendet. Es wurden " + ConvertSize(TargetSize) + " auf Ihr Laufwerk " + HomeDrive + " übertragen", 3
' End of Main

''' Functions
' control processes
Function ProcessControl(proc, state, CheckState)

 If state = "stop" Then ' stop process
  cmd = "taskkill.exe /F /IM " + proc
 Else ' start process  
  cmd = proc
 End If ' end start / stop state
 
 ExitCode = WshShell.run (cmd, 1, true)
 If CheckState = True Then
  If ExitCode > 0 Then
   MsgBox "Fehler beim " + state + " von " + proc, vbCritical
   WScript.Quit
  End If ' end exit code
 End If ' end check state
End Function

' Pretty output for bytes
Function ConvertSize(Size)
 Do While InStr(Size,",")
  CommaLocate = InStr(Size,",")
  Size = Mid(Size,1,CommaLocate - 1) & _
    Mid(Size,CommaLocate + 1,Len(Size) - CommaLocate)
 Loop

 Suffix = " B"
 If Size >= 1024 Then suffix = " KB"
 If Size >= 1048576 Then suffix = " MB"
 If Size >= 1073741824 Then suffix = " GB"
 If Size >= 1099511627776 Then suffix = " TB"

 Select Case Suffix
  Case " KB" Size = Round(Size / 1024, 1)
  Case " MB" Size = Round(Size / 1048576, 1)
  Case " GB" Size = Round(Size / 1073741824, 1)
  Case " TB" Size = Round(Size / 1099511627776, 1)
 End Select

 ConvertSize = Size & Suffix
End Function

' return due dates e.g. till something will be done, see CheckFileCountInFolder
Function RolloutDate(DefaultGateway)
 ' Default
 Rollout = "Offen"
 
 Set objRolloutDates = CreateObject("Scripting.Dictionary")
 ' Foobar town
 objRolloutDates.Add "10.16", "05.09"
 ' Hannover
 objRolloutDates.Add "10.10", "Offen"

 For Each RolloutDate In objRolloutDates
  If InStr(1, DefaultGateway, RolloutDate, VbTextCompare) > 0 Then
   RolloutDate = objRolloutDates(RolloutDate)
   Exit Function
  End If
 Next
End Function

' Copy Folder
Function BackupFolder(Source, Target, Label, maxSize, Required) 
 ' check if source exists
 If objFSO.FolderExists(Source) Then
  ' create target folder
  If Not objFSO.FolderExists(Target) Then
   CreateFolderRecursive Target
  End If ' End check folder
  
  Set objFolder = objFSO.GetFolder(Source) 
  ' returns byte
  FolderSize =  objFolder.Size
  ' copy if folder size is less than ~XXX Megabyte..
  If FolderSize < maxSize Then
   objFSO.CopyFolder Source, Target
  Else
   MsgBox(Label + " ist zu groß: " + ConvertSize(FolderSize) + ". Bitte löschen Sie unnötige Dateien oder verschieben Sie diese auf Ihr Laufwerk H:\. Falls diese Schritte nicht helfen, wenden Sie sich bitte an die Hotline")
  End If ' end of size
 Else
  If Required = True Then
   MsgBox(Label + " (" + Source + ") wurde nicht gefunden, muss aber vorhanden sein!")
   WScript.Quit
  End If
 End If
End Function

' Copy File
Function BackupFile(Source, Filename, Target, Label, maxSize, Required) 

 FullPath = Source + "\" + Filename
 
 ' check if source exists
 If objFSO.FileExists(FullPath) Then
  ' create target folder
  If Not objFSO.FolderExists(Target) Then
   CreateFolderRecursive Target
  End If ' End check folder
  
  Set objFile = objFSO.GetFile(FullPath) 
  ' returns byte
  FileSize =  objFile.Size
  ' copy if folder size is less than ~XXX Megabyte..
  If FileSize < maxSize Then
   objFSO.CopyFile FullPath, Target + "\" + Filename
  Else
   MsgBox(Label + " ist zu groß: " + ConvertSize(FileSize) + ". Bitte löschen Sie diese Datei oder verschieben Sie diese auf Ihr Laufwerk H:\. Falls diese Schritte nicht helfen, wenden Sie sich bitte an die Hotline")
  End If ' end of size
 Else
  If Required = True Then
   MsgBox(Label + " (" + Source + ") wurde nicht gefunden, muss aber vorhanden sein!")
   WScript.Quit
  End If
 End If
 
End Function

' check if x file(s) exist in given path
Function CheckFileCountInFolder(Path, Label, maxFiles)

 FileCount = 0
 
 If objFSO.FolderExists(Path) Then
  Set objFolder = objFSO.GetFolder(Path)
  Set colFiles = objFolder.Files
  For Each objFile In colFiles
   FileCount = FileCount + 1  
  Next
  If maxFiles > 0 And FileCount >= maxFiles Then
   MsgBox( Cstr(FileCount) + " Datei(en) in " + Label + " vorhanden, bitte bis zum " + Chr(34) + RolloutDate(DefaultGateway) + Chr(34) + " abarbeiten / entfernen oder bei der IT-Hotline melden!")
  End If 
 End If ' end FileExists 
End Function

' Copy Folder
Function BackupFolderRecursiveExcludeMaxSize(Source, Target, Label, maxSize, Required) 
 ' check if source exists
 If objFSO.FolderExists(Source) Then
  ' create target folder
  If Not objFSO.FolderExists(Target) Then
   CreateFolderRecursive Target
  End If ' End check folder
  
  Set objFolder = objFSO.GetFolder(Source) 
  Set Files = objFolder.Files
  For Each File in Files
   If Not InStr(1, File.Name, "outlook.ost", VbTextCompare) > 0 Then
    If File.Size < maxSize Then
     File.Copy(Target + "\" + File.Name)
    Else
     MsgBox(Label + " ist zu groß: " + ConvertSize(File.Size) + ". Bitte löschen Sie diese Datei oder verschieben Sie diese auf Ihr Laufwerk H:\. Falls diese Schritte nicht helfen, wenden Sie sich bitte an die Hotline")
    End If
   End If
  Next 
 Else
  If Required = True Then
   MsgBox(Label + " (" + Source + ") wurde nicht gefunden, muss aber vorhanden sein!")
   WScript.Quit
  End If
 End If
 
End Function

' Check target drive
Function CheckDrive(Drive)
  
 If objFSO.DriveExists(Drive) Then
  Set DriveState = objFSO.GetDrive(Drive)  
  ' Check home drive 
  If Not DriveState.IsReady = True Then
   ErrorText = "Laufwerk " + Drive + " ist nicht erreichbar, bitte starten Sie den PC neu!"
   ErrorOccured = True
  Else 
   ' 0: unkown, 1: Removable, 2: Fixed, 3: Network, 4: CD-Rom, 5: RAM-Disk
   If Not DriveState.DriveType = 1 And Not DriveState.DriveType = 2 And Not DriveState.DriveType = 3 Then 
    ErrorText = Drive + ": ist kein gültiger Laufwerkstyp, mögliche Typen: Netzwerk, Festplatte, Wechseldatenträger"
    ErrorOccured = True
   End If ' end check valid drive type
  End If
 Else
   ErrorText = "Laufwerk " + Drive + " existiert nicht, bitte starten Sie den PC neu!"
   ErrorOccured = True
 End If ' End Drive exists
 
 If ErrorOccured = True Then
  MsgBox(ErrorText)
  WScript.Quit
 End If
End Function

Function CreateFolderRecursive(FullPath)
 Set oFs = WScript.CreateObject("Scripting.FileSystemObject")
 arr = split(FullPath, "\")
 path = ""
 For Each dir In arr
  If path <> "" Then path = path & "\"
  path = path & dir
  If oFs.FolderExists(path) = False Then oFs.CreateFolder(path)
 Next
End Function

' EOF

Das Skript sollte angepasst, getestet und im NETLOGON Verzeichnis abgelegt werden, anschließend kann es im Login-Skript verankert werden und sichert ab diesem Zeitpunkt automatisch bei jeder Anmeldung die Daten.

Zum Download

Bei Fragen bitte melden!

Sekretariate und Chefs die eigene Kalendereinträge erstellen/verändern

Microsoft Outlook bietet nützliche Funktionen um eine Vertretung oder ein Sekretariat zu unterstützen.

Eine wichtige Funktion gibt es allerdings nicht, nämlich eine Information, wenn der Eigentümer eines Kalenders selber Einträge hinzufügt, ändert oder löscht.
Diese Informationen gehen komplett am Sekretariat vorbei und müssten manuell kommuniziert werden, da wir aber die Welt kennen, geht sowas natürlich häufig unter und das Terminchaos ist vorprogrammiert...

Damit das nicht passiert, habe ich eine Outlook VBA Erweiterung geschrieben, welche diese Funktionen nachrüstet.

Achtung, da ich eig. kein VBA-Entwickler bin, kann der Code wahrscheinlich noch besser sein, aber für den Anwendungsfall reicht es wohl..

Unterstützte Funktionen:

• Hinzufügen eines Eintrags
• Ändern eines Eintrags
• Löschen eines Eintrags
• Separate Anzeige für Ganztägige Termine
• Übersetzbar
• Automatisches Ausblenden des Betreff,Inhalt und Ort bei "Privat" Markierung

Beispiel:

E-Mail Subject: Hinzugefügt: Kalendereintrag "Ein neuer Termin" von Skibbe, Oliver

E-Mail Inhalt:
Hinzugefügt: Kalendereintrag "Ein neuer Termin" von Skibbe, Oliver
Start: 10:30 am Mittwoch, 10. Juli 2013
Ende: 13:00 am Mittwoch, 10. Juli 2013
Status: Beschäftigt
Ort: Hannover
Inhalt: Besprechung mit XY zum Thema Z

Und hier der Code:

Option Explicit

'   This program is free software: you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation, either version 3 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program.  If not, see <http://www.gnu.org/licenses/.
'
'   Dieses Programm ist Freie Software: Sie können es unter den Bedingungen
'   der GNU General Public License, wie von der Free Software Foundation,
'   Version 3 der Lizenz oder (nach Ihrer Option) jeder späteren
'   veröffentlichten Version, weiterverbreiten und/oder modifizieren.
'
'   Dieses Programm wird in der Hoffnung, dass es nützlich sein wird, aber
'   OHNE JEDE GEWÄHRLEISTUNG, bereitgestellt; sogar ohne die implizite
'   Gewährleistung der MARKTFÄHIGKEIT oder EIGNUNG FÜR EINEN BESTIMMTEN ZWECK.
'   Siehe die GNU General Public License für weitere Details.
'
'   Sie sollten eine Kopie der GNU General Public License zusammen mit diesem
'   Programm erhalten haben. Wenn nicht, siehe <http://www.gnu.org/licenses/
' 
'   Author: Oliver Skibbe ( oliskibbe at gmail.com )
'   Date: 2013-07-09
'   Purpose: Send mail to a configurable person if an calendar event is created, modified or deleted
'   Tested with: Outlook 2007
'   Hints:
'       http://www.vbarchiv.net/commands/details.php?id=formatdatetime
'       http://msdn.microsoft.com/en-us/library/office/bb208262%28v=office.12%29.aspx
'   Changelog:
'       2013-07-01 Oliver Skibbe: first release
'       2013-07-02 Oliver Skibbe: added check if private item (clear text if it is), added busy state to Output
'       2013-07-02 Oliver Skibbe: added allday check


Private WithEvents Items As Outlook.Items
Private WithEvents Reminders As Outlook.Reminders
Private WithEvents objCalFolder As Outlook.folder
Dim objDelFolder As Outlook.folder

' Helper variables
Public isDeletedBool As Boolean
Public reminderOccuredBool As Boolean

' Mail stuff
Public receiverStrg As String
Public subjectStrg As String
Public subjectPartStrg As String
Public bodyStrg As String

' Appointment helper strings
Public apptOrganizerStrg As String
Public apptLocationStrg As String
Public apptStartDateStrg As String
Public apptEndDateStrg As String
Public apptSubjectStrg As String
Public apptBodyStrg As String
Public apptBusyStateStrg As String
Public apptSensitivityStrg As String

' Translation
Public transAllDayEventStrg As String
Public transPrivateItemStrg As String
Public transAtStrg As String
Public transOfStrg As String
Public transAddedStrg As String
Public transChangedStrg As String
Public transDeletedStrg As String
Public transAvailStateStrg As String
Public transTentStateStrg As String
Public transBusyStateStrg As String
Public transOOOStateStrg As String
Public transCalendarStrg As String
Public transBodyStrg As String
Public transStateStrg As String
Public transLocationStrg As String
Public transStartStrg As String
Public transEndStrg As String

' subs
Private Sub Application_Startup()

  ' Receiver
  receiverStrg = "change.me@example.org"
  
  ' translation...modify if needed
  transAllDayEventStrg = "Ganztägig"
  transPrivateItemStrg = "Privater Termin"
  transAtStrg = "am"
  transOfStrg = "von"
  transAddedStrg = "Hinzugefügt"
  transChangedStrg = "Geändert"
  transDeletedStrg = "Gelöscht"
  transAvailStateStrg = "Verfügbar"
  transTentStateStrg = "Mit Vorbehalt"
  transBusyStateStrg = "Beschäftigt"
  transOOOStateStrg = "Abwesend"
  transCalendarStrg = "Kalendereintrag"
  transBodyStrg = "Inhalt"
  transStateStrg = "Status"
  transLocationStrg = "Ort"
  transStartStrg = "Start"
  transEndStrg = "Ende"
  
  Dim Ns As Outlook.NameSpace
  Dim CalFolder As Outlook.MAPIFolder
  Set Reminders = Outlook.Application.Reminders
  
  ' default values ..
  isDeletedBool = False
  reminderOccuredBool = False
    
  Set Ns = Application.GetNamespace("MAPI")
  Set CalFolder = Ns.GetDefaultFolder(olFolderCalendar)
  ' Set Folder = CalFolder.Folders("Subfolder")
  Set Items = CalFolder.Items
  
  Set objCalFolder = Application.Session.GetDefaultFolder(olFolderCalendar)
  Set objDelFolder = Application.Session.GetDefaultFolder(olFolderDeletedItems)
  
End Sub

' item add event
Private Sub Items_ItemAdd(ByVal Item As Object)
    ' Objects
    Dim Appt As Outlook.AppointmentItem
    
    ' if meeting or appointment..
    If TypeOf Item Is Outlook.AppointmentItem Or TypeOf Item Is Outlook.MeetingItem Then
        ' Appointment properties
        Set Appt = Item
        ' mail strings
        apptOrganizerStrg = Appt.Organizer
        ' AllDayEvent
        If Appt.AllDayEvent = True Then
            apptStartDateStrg = transAllDayEventStrg + ", " + FormatDateTime(Appt.Start, 1)
            ' we have to subtract one day to get a nice looking result
            apptEndDateStrg = transAllDayEventStrg + ", " + FormatDateTime(DateAdd("d", -1, Appt.End), 1)
        Else
            apptStartDateStrg = FormatDateTime(Appt.Start, 4) + " " + transAtStrg + " " + FormatDateTime(Appt.Start, 1)
            apptEndDateStrg = FormatDateTime(Appt.End, 4) + " " + transAtStrg + " " + FormatDateTime(Appt.End, 1)
        End If
        apptLocationStrg = Appt.Location
        apptBusyStateStrg = format(Appt.BusyStatus)
        apptSensitivityStrg = format(Appt.Sensitivity)
        apptBodyStrg = Appt.Body
        apptSubjectStrg = Appt.Subject
        subjectPartStrg = transAddedStrg
        
        ' send mail
        Call sendMail
    End If
End Sub

' busy state mapping
'   olBusy          2   The user is busy.
'   olFree          0   The user is available.
'   olOutOfOffice   3   The user is out of office.
'   olTentative     1   The user has a tentative appointment scheduled.
Private Sub busyState()
    Select Case apptBusyStateStrg
        Case Is = 0
            apptBusyStateStrg = transAvailStateStrg
        Case Is = 1
            apptBusyStateStrg = transTentStateStrg
        Case Is = 2
            apptBusyStateStrg = transBusyStateStrg
        Case Is = 3
            apptBusyStateStrg = transOOOStateStrg
        End Select
End Sub

' check if an calendar item is about to be deleted
Private Sub objCalFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)

    ' Objects
    Dim Appt As Outlook.AppointmentItem

    ' if meeting or appointment..
    If TypeOf Item Is Outlook.AppointmentItem Or TypeOf Item Is Outlook.MeetingItem Then
        ' Appointment properties
        Set Appt = Item
        
        ' saving calendar values for later purposes
        apptOrganizerStrg = Appt.Organizer
        ' AllDayEvent
        If Appt.AllDayEvent = True Then
            apptStartDateStrg = transAllDayEventStrg + ", " + FormatDateTime(Appt.Start, 1)
            ' we have to subtract one day to get a nice looking result
            apptEndDateStrg = transAllDayEventStrg + ", " + FormatDateTime(DateAdd("d", -1, Appt.End), 1)
        Else
            apptStartDateStrg = FormatDateTime(Appt.Start, 4) + " " + transAtStrg + " " + FormatDateTime(Appt.Start, 1)
            apptEndDateStrg = FormatDateTime(Appt.End, 4) + " " + transAtStrg + " " + FormatDateTime(Appt.End, 1)
        End If
        apptLocationStrg = Appt.Location
        apptBusyStateStrg = format(Appt.BusyStatus)
        apptSensitivityStrg = format(Appt.Sensitivity)
        apptBodyStrg = Appt.Body
        apptSubjectStrg = Appt.Subject
    End If
    
    ' check if item is deleted
    If MoveTo Is Nothing Then
        isDeletedBool = True
        Call Items_ItemChange(Item)
    ElseIf MoveTo = objDelFolder Then
        isDeletedBool = True
        Call Items_ItemChange(Item)
    End If
End Sub

Private Sub Items_ItemChange(ByVal Item As Object)
   
    ' Objects
    Dim Appt As Outlook.AppointmentItem
    
    ' if meeting or appointment..
    If TypeOf Item Is Outlook.AppointmentItem Or TypeOf Item Is Outlook.MeetingItem Then
    
        ' leave sub if just a reminder occured ( is set by: Sub Reminders_BeforeReminderShow )
        If reminderOccuredBool = True Then
            Exit Sub
        End If

        Set Appt = Item
        
        ' is set by Sub objCalFolder_BeforeItemMove
        If isDeletedBool = False Then
            apptOrganizerStrg = Appt.Organizer
            ' AllDayEvent
            If Appt.AllDayEvent = True Then
                apptStartDateStrg = transAllDayEventStrg + ", " + FormatDateTime(Appt.Start, 1)
                ' we have to subtract one day to get a nice looking result
                apptEndDateStrg = transAllDayEventStrg + ", " + FormatDateTime(DateAdd("d", -1, Appt.End), 1)
            Else
                apptStartDateStrg = FormatDateTime(Appt.Start, 4) + " " + transAtStrg + " " + FormatDateTime(Appt.Start, 1)
                apptEndDateStrg = FormatDateTime(Appt.End, 4) + " " + transAtStrg + " " + FormatDateTime(Appt.End, 1)
            End If
            apptLocationStrg = Appt.Location
            apptSensitivityStrg = format(Appt.Sensitivity)
            apptBusyStateStrg = format(Appt.BusyStatus)
            apptBodyStrg = Appt.Body
            apptSubjectStrg = Appt.Subject
            subjectPartStrg = transChangedStrg
        Else
            ' part of subject
            subjectPartStrg = transDeletedStrg
        End If
  
        ' send mail
        Call sendMail
    End If
End Sub

' Before reminder is shown, set variable to surpress ItemChange
Private Sub Reminders_BeforeReminderShow(Cancel As Boolean)
    reminderOccuredBool = True
End Sub

' finally prepare and send mail
'       olConfidential  3   Confidential
'       olNormal        0   Normal sensitivity
'       olPersonal      1   Personal
'       olPrivate       2   Private
Private Sub sendMail()
    
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    ' default values for body and location string
    If LenB(apptBodyStrg) = 0 Or apptSensitivityStrg > 0 Then
        apptBodyStrg = "-"
    End If
    If LenB(apptLocationStrg) = 0 Or apptSensitivityStrg > 0 Then
        apptLocationStrg = "-"
    End If
    If LenB(apptSubjectStrg) = 0 Or apptSensitivityStrg > 0 Then
        apptSubjectStrg = "-"
    End If
    If apptSensitivityStrg > 0 Then
        subjectPartStrg = transPrivateItemStrg + ": " + subjectPartStrg
    End If
    
    ' busy State string mapping
    Call busyState
    
    ' Subject
    subjectStrg = subjectPartStrg + ": " + transCalendarStrg + " " + Chr(34) + apptSubjectStrg + Chr(34) + " " + transOfStrg + " " + apptOrganizerStrg
    ' Body
    bodyStrg = subjectPartStrg + ": " + transCalendarStrg + " " + Chr(34) + apptSubjectStrg + Chr(34) + " " + transOfStrg + " " + apptOrganizerStrg + vbCrLf _
                    + vbCrLf _
                    + transStartStrg + ": " + apptStartDateStrg + vbCrLf _
                    + transEndStrg + ": " + apptEndDateStrg + vbCrLf _
                    + transStateStrg + ": " + apptBusyStateStrg + vbCrLf _
                    + transLocationStrg + ": " + apptLocationStrg + vbCrLf _
                    + vbCrLf _
                    + transBodyStrg + ": " + apptBodyStrg
                    
    With OutMail
        .To = receiverStrg
        .Subject = subjectStrg
        .Body = bodyStrg
        .Display
        .Send
    End With
End Sub

Der Code muss in den Visual-Basic Editor (Alt+F11) unter: Projekt1 -> Microsoft Office Outlook -> ThisOutlookSession beim Kalendereigentümer eingebunden werden.

Ich hoffe es hilft einigen Leuten, gerade der Part mit gelöschten Mails war etwas knifflig.



Bei Fragen zu dem Code kontaktiert mich bitte