ICS Dateien automatisch in Outlook importieren

' IMPORT MULTIPLE ICS FILES INTO OUTLOOK  
On Error Resume Next

' Variablen deklarieren  
Dim ol,fso,objShell,start,file,isError

' Ordner in dem sich die *.ics Dateien befinden  
Const QUELLE = "D:\Termine"  
' Maximale Wartezeit für das Warten auf Outlook und das öffnen der Inspector-Fenster beim öffnen der ICS-Files (in Sekunden)  
Const MAXWAITLOOP = 10

' Erzeuge nötige Objekte  
Set ol = CreateObject("Outlook.Application")  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set objShell = CreateObject("Wscript.Shell")  

'Starte Outlook explizit (nötig damit hier auf die geöffneten Inspector zugeriffen werden kann)  
objShell.Run "outlook.exe"  
start = Timer()
Do Until ol.Explorers.Count > 0
	If (start + MAXWAITLOOP) <= Timer() Then
		WScript.Quit
	End If
Loop

' Für jedes *.ics File im Ordner  
For Each file In fso.GetFolder(QUELLE).Files
	If LCase(fso.GetExtensionName(file.Name)) = "ics" Then  
		' öffne das ICS File  
		objShell.Run "outlook.exe /ical """ & file.Path & """"  
		start = Timer()
		isError = False
                'warte bis der Inspector geöffnet wurde  
		Do Until ol.Inspectors.Count > 0
			' springe aus der Schleife wenn maximale Wartezeit erreicht ist  
			If (start + MAXWAITLOOP) <= Timer() Then
				isError = True : Exit Do
			End If
		Loop
		If Not isError Then
			' Termine im Kalender speichern  
			ol.Inspectors.Item(1).CurrentItem.Close 0
		End If
	End If
Next
' Outlook schließen  
ol.Quit

' cleanup  
Set fso = Nothing
Set ol = Nothing
Set objShell = Nothing