VBS - Kann man die Datendatei aus Outlook entfernen und neu hinzufügen?

Hallo an alle Forenteilnehmer,

das man aus Outlook bestimmte Dinge durch Instanzieren des Objektes herauslesen ist mir klar.

Gibt es eine Möglichkeit, dass man in Outlook die Datendateien per VB-Skript entfernt und dort
z.B. eine neue PST-Datei als Datendatei hinzufügt.

Hintergrund ist der, dass ich bei vielen Anwendern im Netzwerk die PST-Dateien nicht manuell aus
Outlook heraus löschen, die PST-Datei auf ein neues Laufwerk verschieben und dann neu hinzufügen möchten.

Das herauslesen der eingerichteten PST-Dateien und das kopieren auf das neue Laufwerk inkl. ACLs funktioniert schon.

Wie kann ich den Datenpfad in Outlook per VB-Skript ändern-/löschen-/hinzufügen?

Für ein kleines Beispiel wäre ich dankbar.

Gruß

Thomas

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 207819

Url: https://administrator.de/contentid/207819

Ausgedruckt am: 20.11.2024 um 13:11 Uhr

13 Kommentare

Neuester Kommentar

Hallo Thomas,

lese mal folgenden Artikel: Powershell - Datendateien in Outlook auslesen und aendern (Lokale PCs)

Grüße Uwe

Hallo Uwe,

das ist ja mein Beitrag.

Hier ging es ums auslesen.

Ich möchte aber etwas in Outlook ändern (Nur VBS), das beantwortet mir leider nicht die Frage.

Aber trotzdem danke für die Hilfe.

Gruß
Thomas

Sorry hat ich glatt übersehen, dachte schon, den Namen Thomas hast du in letzter Zeit schon mal gesehen

Hallo Thomas,

wenn Du es bereits aulesen kannst, müßtest Du es auch wieder schreiben können. Ich bin jetzt kein VBS bzw. Powershell Experte. Schau mal bei powershell.com oder Google nach Pfadnamen schreiben, oder ähnlich.

Gruss Penny.

Hallo Penny,

das dachte ich mir auch, wenn ich aus der Instanz auslesen kann, müsste doch schreiben kein Problem sein.
Aber weit gefehlt! Suche schon seit ca. eine Stunde im Netz und habe noch nichts brauchbares gefunden.
Einzig alleine ein paar Registry-Werte, mit Werte die beim anlegen frei von Microsoft gewählt werden unter

HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\

Alle anderen Registryzweige, die ich gefunden haben, haben leider keine Auswirkungen, wenn ich diese manuell ändere.
Das wäre das einfachste gewesen.

Vielleicht weiß jemand aus diesem Forum, wo der genaue Speicherort der PST-Dateien liegen, so dass ich einfach die Pfade anpassen kann. Ich denke mit dem Thema hat sich bestimmt schon jemand befasst und vielleicht eine Lösung parat.

Mal gespannt, ob noch was brauchbares kommt.

PS: Für eine Powershell-Lösung wäre ich auch dankbar. Hier kann man sehr viel mit Microsoft Exchange machen. Ob das aber mit dem lokal installierten Outlook auch geht, weiß ich im Moment nicht. Sicher gibt es hier eine Lösung mit dieser mächtigen Skriptsprache.

Liebe Grüße

Thomas

Hatte ich doch im letzten Thread schon verlinkt, vielleicht kannst du damit was anfangen:
http://www.vbforums.com/showthread.php?650266-RESOLVED-Modify-PST-locat ...!

Der Beitrag ist interessant.

Werde den mal durchlesen und versuchen, ob ich hier Lösungsansätze finde.

Wenn es funktioniert. werde ich die Lösung hier posten.

Danke erst mal für den Link.

Thomas

Hallo colinardo,

der Link hat Lösungsansätze bezgl. des Registrykeys, den ich schon gefunden habe.

Weiß leider nicht, mit welchem Wert ich die Funktion aufrufen kann.

Vielleicht kann mir jemand hier noch helfen.

Danke im Voraus.

Gruß
Thomas

Glaube der ist verständlicher :http://scripts-and-bits.blogspot.de/2012/05/vbscript-to-migrate-outlook ...

Der letzte Link ist genial.

Ist zwar in umgekehrter Richtung, aber ich schreibe es um und werde es dann hier posten.

Gruß

Thomas

Hallo cainardo,

habe das hinbekommen mit den Outlook-Dateien.

Mein Testskript, ermittelt die PST-Dateien, die in Outlook eingebunden sind und speichert sie in einem Array.

Bei mir werden alle eingebundenen PST-Dateien, die nicht auf C: D: und V: liegen ermittelt und in einem zweiten Array gespeichert.

Dann werden diese verschoben und wieder in Outlook angepasst.
Sobald der Vorgang abgeschlossen ist, erscheint in der Outlook-Konfiguration in den Kontoeinstellungen unter Datendateien die geänderten Konfigurationsdaten z.B. V:\Intern\Outlook

Ein kleiner Schönheitsfehler:

Wenn ein Name in Outlook für die PST benannt wurde z.B. Archiv 2012 und die PST-Datei heißt nur Archiv.pst, dann
wird hier beim Namen Archiv.pst eingetragen.

Habe das im Loginskript eingebaut und die angemeldeten Anwender bekommen einen Hinweis, ob die Dateien verschoben werden. Solange das nicht bejaht wird, kommt die Aufforderung erneut. Ist dies mal ausgeführt, dann kommt dieser Dialog nicht mehr. Hintergrund war, dass die PST-Dateien sehr viel Platz auf einigen Netzlaufwerke belegen und diese wieder mehr Platz benötigen.

Evtl. kann mir jemand noch dabei helfen.

Würde gerne das Skript hier hochladen.

Wie mache ich das korrekt, so dass die Zeilen korrekt angezeigt werden?

Liebe Grüße

Thomas

Schön das es geklappt hat.
Wie man Code formatiert steht hier
Grüße Uwe

So hier der Code:

 

Outlook_PST_verschieben()

Msgbox "Fertig mit dem verschieben der PST-Dateien auf V:\Intern\Outlook"  



Function Outlook_PST_verschieben()

		' ------------------------  
		' Variablen dimensionieren  
		' ------------------------  

		DIM objFSO, objDatei, objDateien, objQuellOrdner, strQuelle, strZielordner, strNachricht
		DIM pstArray()
		DIM Zaehler : Zaehler = 0
		DIM objOL 

		strZielOrdnerPfad	= "V:\Intern\Outlook\"  

		SET pstInfo 		= createobject("scripting.Dictionary")  
		SET objOutlook 		= CreateObject("Outlook.Application")  
		SET objOL 			= objOutlook.GetNamespace("MAPI")  
		SET objFSO 			= CreateObject("Scripting.FileSystemObject")  

		a = 0

		On Error Resume Next

		' ----------------------------------------------------------------------------  
		' Lese Alle Outlook PST-Datendateien aus und speiche Sie in dem Array pstArray  
		' ----------------------------------------------------------------------------  

		For Each objFolder In objOL.Session.Folders 

			' ----------------------------  
			' Alle Datemdateien in Outlook  
			' ----------------------------  
			
			If not isEmpty(ErmittlePSTPfadReg(objFolder.storeid)) then ' Filtere die leeren Einträge raus  

				' ------------------------------------------  
				' Liefert den PST-Dateipfad als Text zurück!  
				' ------------------------------------------  
			  
				pstPfad = ErmittlePSTPfadReg(objFolder.storeid) 
				reDIM preserve pstArray(Zaehler)
				pstArray(Zaehler) = pstPfad
				Zaehler = Zaehler + 1
				pstInfo.add pstPfad,objFolder
			End If
		Next

		' Msgbox "Anzahl PST-Dateien = " & Zaehler ' Kontrollausgabe  

		' ------------------------------------------------------------------------------  
		' Zähler für Anzahl PST-Dateien außer C: D: V:, die in Outlook eingebunden sind!  
		' ------------------------------------------------------------------------------  

		strAnzahlPSTNetzwerk = 0

		' --------------------  
		' Zähler für Schleifen  
		' --------------------  

		i = 0

		' ----------------------------------------------------------------------------------------------------------------  
		' PST-Dateien aus Array auslesen und nur die Netzwerk-PST-Dateien au0er C: D: V: in neuem Array pstNWArray ablegen  
		' ----------------------------------------------------------------------------------------------------------------  

		DIM pstNWArray(40)

				' -------------------------------------------------------------------------  
				' PST-Dateien, die auf dem C: oder D: oder V: Laufwerk liegen, außschließen  
				' pstArray(a) --> Inhalt z.B.: C:\Temp\Intern\Outlook\MeineDaten.pst  
				' -------------------------------------------------------------------------  

				strAnzahlPSTNetzwerk = 0
				
				For i = 0 to Zaehler-1
					strDateiPfad = pstArray(i)
					
					' ---------------------------------------------------------------------------------------------------  
					' Dateipfad aufsplitten, so dass z.B. x= C: oder TEMP oder Intern usw. erscheint (Beispielpfad oben!)  
					' ---------------------------------------------------------------------------------------------------  

					x = Left(strDateiPfad, 2)
					Select Case x
						Case "C:" ' Nicht unternehmen!  
						Case "D:" ' Nicht unternehmen!  
						Case "V:" ' Nicht unternehmen!  
						Case "H:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "I:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "J:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "K:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "L:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "M:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "N:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "O:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "P:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "Q:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "R:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "S:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "T:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "U:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "V:" ' Nicht unternehmen!  
						Case "W:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "X:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "Y:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						Case "Z:"  
							pstNWArray(strAnzahlPSTNetzwerk) = strDateiPfad
							strAnzahlPSTNetzwerk = strAnzahlPSTNetzwerk + 1
						
					End Select
				Next

		' ------------------------------------------------------------------------  
		' Jetzt steht in der Variable strAnzahlPSTNetzwerk die Anzahl PST-Dateien,  
		' die aus dem pstNWAray ausgelesen werden kann  
		' Das Array pstNWArray(x) stehen jetzt alle PST-Dateien, die implizit   
		' erlaubt sind zum kopieren-/verschieben auf das Ziellaufwerk  
		' -------------------------------------------------------------------------  

		' Msgbox "Anzahl PST-Dateien, die kopiert-/verschoben werden: " & strAnzahlPSTNetzwerk ' Kontrollausgabe  

		' -------------------  
		' Zähler für Schleife  
		' -------------------  

		i = 0

		' --------------------------------------------------------------------------------  
		' PST-Datei, die über Select Case ermittelt worden sind anzeigen (Kontrollausgabe)  
		' --------------------------------------------------------------------------------  

		'For i = 0 to strAnzahlPSTNetzwerk-1  
		'	Msgbox pstNWArray(i)  
		'Next  

		pstKeys = pstInfo.keys 

		' ----------------------------------------------------------  
		' Selective PST-Dateien außer C: D: V: aus Outlook entfernen  
		' ----------------------------------------------------------  

		For Each key in pstKeys

		' -----------------------------------------------------------------  
		' Wenn PST-Datei auf dem Netzwerk Freigabelaufwerk gespeichert ist!  
		' -----------------------------------------------------------------  

			If ErmittleLaufwerksTyp(left(key,2)) = "Network" Then   
			 
			 ' ---------------------  
			 ' Netzwerk PST-Dateien!  
			 ' ---------------------  
			
			' ------------------------------------------------------  
			 ' PST entladen, sonst kann diese nicht gelöscht werden!  
			 ' -----------------------------------------------------  
			 
				 objOL.RemoveStore pstInfo.item(key) 
			End if
		Next



		' ---------------------------------------------------  
		' Hier kommt die Routine, um die Netzwerk-PST-Dateien   
		' in Laufwerk, Pfad und Datei aufzusplitten  
		' ---------------------------------------------------  


		i = 0

		For i = 0 to strAnzahlPSTNetzwerk-1
			
			' --------------------------------------  
			' Compare = Vergleichswert bei InStrRev,   
			' 0 = Binärvergleich, 1 = Textvergleich  
			' -------------------------------------  
			
			intTextVergleich = 1
			
			' ----------------------------------------------------------------------------------------------------------  
			' Spezifiziert die Startposition für jede Suche. Die Suche beginnt an der Position des letzten Zeichens (-1)  
			' ----------------------------------------------------------------------------------------------------------  
			
			Startposition = -1 
			
			' ------------------------------  
			' Laufwerksbuchstabe extrahieren  
			' ------------------------------  
			
			strLaufwerk = Left(pstNWArray(i),2)
			
			' -----------------------------  
			' nur den Dateiname extrahieren  
			' -----------------------------  
			
			strPSTDateiname = Right(pstNwArray(i), Len (pstNwArray(i)) - InStrRev(pstNwArray(i), "\" ,Startposition, intTextVergleich))  

			' --------------------------------------  
			' Den Pfad ohne den Dateinamen ermitteln  
			' --------------------------------------  
			
				' ------------------------------------------  
				' Zuerst die Länge des Dateinamens ermitteln  
				' ------------------------------------------  
				
				intLaenge_Dateiname = Len(strPSTDateiname)
				
				' ---------------------------------------------------------------------------------  
				' Der komplette Pfad, ohne den Dateinamen kann jetzt sehr leicht ermittelt werden,  
				' Hierzu einfach erst mal aus dem jeweiligen Kompletten Pfad die Länge des    
				' Dateinamens abziehen und den String extrahieren  
				' ---------------------------------------------------------------------------------  
				
				intLaengePfad = Len( pstNwArray(i) ) - intLaenge_Dateiname
				
		'		Msgbox 	"Pfad+Dateiname: " & pstNwArray(i) & vbCRLF & _  
		'				"Länge Kompletter Pfad+Dateiname: " & Len(pstNwArray(i)) & vbCRLF & _  
		'				"Länge Dateiname = " & intLaenge_Dateiname & vbCRLD & _  
		'				"Laenge Pfad: " & intLaengePfad  
						
		'	Msgbox strPSTDateiname ' Kontrollanzeige  
			
			' -------------------------------------------------------------------  
			' Outlook beenden, sonst schlägt der Verschieben-/Kopiervorgang fehl!  
			' -------------------------------------------------------------------  
			
			Prozess_beenden("Outlook.exe")  
			Prozess_beenden("SearchprotocolHost.exe")  
			
			' -------------------------------------------------------  
			' Hier kommt die Routine, um die Netzwerk-PST-Dateien auf   
			' das Ziel-PST-Laufwerk zu kopieren-/verschieben  
			' -------------------------------------------------------  
			
			SET objQuellOrdner 	= objFSO.GetFolder(pstNwArray(i)) 	' Aktuellen Dateipfad mit Dateiname zuordnen!  
			SET objDateien 		= objQuellOrdner.Files				'   
			
			For Each objDatei In objDateien

				' Weise strQuelle den kompletten Pfad inkl. PST-Datei (Nur die Dateien außer C: D: V:) zu.  
				
				strQuelle = pstNwArray(i)
				
				' -----------------------------------------------------------------------------------------------------------  
				' Verschiebe Datei  
				'  
				' Anmerkung:   
				'  
				' Falls die Datei nicht existiert, dann verschiebe einfach  
				' Wenn die Datei im Zielordner existiert, dann wird ein Fehler ausgegeben (wird abgefangen und unterdrückt!"  
				' Wenn das Ziel nur ein Verzeichnis ist, dann wird ein Fehler ausgegeben (wird abgefangen und unterdrückt!"  
				' -----------------------------------------------------------------------------------------------------------  
				objFSO.MoveFile strQuelle, strZielOrdnerPfad
				
				' ----------------  
				' Fehlerbehandlung  
				' ----------------  
				
				If Err.Number <> 0 Then
				
					strNachricht = Err.Description

					Select Case Err.Number
						Case 58 ' Datei ist bereits vorhanden!  
							' In diesem Fall nichts unternehmen, Datei belassen, wie sie ist  
						Case 76 '   
							' Es wird kein Fehler ausgegeben!  
						Case 450
							' Falsche Anzahl an Argumenten oder ungültige Eigenschaftszuweisung  
						Case Else
							' Es wird kein Fehler ausgegeben  

					End Select
				 
					'MsgBox "Fehlercode: " & Err.Number & vbCRLF & "Fehlerbeschreibung: " & strNachricht, 48, "Fehler!"  
					Err.Clear
				End If
			Next	
		Next

		' -----------------------------------------------------------------------  
		' Vorher entfernte PST-Dateien (in Outlook) wieder in Outlook hinzufügen  
		' Diesmal mit neuem Pfad, so dass bei nächsten Start, diese ohne Probleme  
		' wieder geöffnet werden können!  
		' ------------------------------------------------------------------------  

			' --------------------------  
			' Zuerst Objekt instanzieren  
			' --------------------------  
			
			SET objOutlook = CreateObject("Outlook.Application")  
			SET objOL = objOutlook.GetNamespace("MAPI")  
			wscript.sleep 3000

		i = 0


		For Each key in pstKeys
			' --------------------------------------------------------------------------------------------  
			' key = Enthält den kompletten Quellpfad inkl. PST-Dateiname z.B.: H:\Outlook-Dateien\Test.pst  
			' --------------------------------------------------------------------------------------------  
			
			If 	ErmittleLaufwerksTyp(left(key,2)) = "Network" Then  
			
				' ----------------------------------------------------------  
				' strDateiname = Enthält nur den PST-Dateinamen z.B.Test.pst  
				' ----------------------------------------------------------  
				
				strDateiname = objFSO.GetBaseName(key) + ".pst"  
				
				' -----------------------------------------------------------------------------------  
				' strZieldateiname = Enthält den Pfad+Dateiname z.B.: C:\Temp\Intern\Outlook\Test.pst  
				' -----------------------------------------------------------------------------------  
				
				strZieldateiname = strZielOrdnerPfad & strDateiname 
				
				' ------------------------------------  
				' In Outlook die Datendatei hinzufügen  
				' ------------------------------------  
				
				objOL.AddStore strZieldateiname
				
				' ------------------------------------------------------------------------------  
				' Solange hinzufügen, soviele Dateien, die ermittelt worden sind, außer C: D: V:  
				' ------------------------------------------------------------------------------  
				
				i = i + 1
				If strAnzahlPSTNetzwerk = i then exit for
				wscript.sleep 500
			End If
		Next
End Function ' Outlook_PST_verschieben()  


' ----------  
' Funktionen  
' ----------  


Function ErmittleLaufwerksTyp(strLaufwerkstyp) 

	' ------------------------------------------------------------------  
	' Liefert den Typ des Laufwerkes zurück, wo die PST gespeichert ist!  
	' ------------------------------------------------------------------  
	
	 strComputer = "."  
	 
	 SET objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")  
	 SET colItems = objWMIService.ExecQuery("Select * from Win32_logicaldisk")  
	 
	 For Each objItem In colItems
		If objItem.driveType = "4" And  objItem.deviceID = strLaufwerkstyp Then   
			' Netzlaufwerk  
			ErmittleLaufwerksTyp = "Network"  
		ElseIf objItem.driveType = "2" And  objItem.deviceID = strLaufwerkstyp Then   
			' Wechsellaufwerk  
			ErmittleLaufwerksTyp = "Removable"  
		ElseIf objItem.driveType = "3" And  objItem.deviceID = v Then   
			' Lokale Festplatte  
			ErmittleLaufwerksTyp = "Local Disk"  
		End If
	 Next
End Function


Function ErmittlePSTPfadReg(strPfad)

	' -------------------------------------------------  
	' Ermittel den Pfad der PST-Datei aus der Reg-Datei  
	' Hier wird kryptische Werte zurück geliefert, die  
	' aber essentiell wichtig sind für den Umzug der  
	' PST-Dateien  
	' Werte werden von objFolder.storeid aus der  
	' Outlook Instanz ermittelt.  
	' Erforderlich:  
	'  
	' SET objOL = objOutlook.GetNamespace("MAPI")  
	' -------------------------------------------------  

	For i = 1 To Len(strPfad) Step 2
		strUnterString = Mid(strPfad,i,2)
		If Not strUnterString = "00" Then	strPath = strPath & ChrW("&H" & strUnterString)  
	Next
	 
	Select Case True
		Case InStr(strPath,":\") > 0 : ErmittlePSTPfadReg = Mid(strPath,InStr(strPath,":\")-1)  
		Case InStr(strPath,"\\") > 0 : ErmittlePSTPfadReg = Mid(strPath,InStr(strPath,"\\"))  
	End Select

End Function


Function Prozess_beenden(strProzessname)

' -------------------  
' Beendet ein Prozess  
' -------------------  

	Set owmi = GetObject("winmgmts:")  
	Set Task = owmi.ExecQuery("select * from win32_process Where Name = '" & strProzessname & "'")  
	Set WshShell = WScript.CreateObject("WScript.Shell")  

	WScript.Sleep 1000 ' 1 Sekunde warten  

	If IsEmpty(Task) Then
		WScript.Quit
	End If

	For Each objekt in Task
		WshShell.AppActivate(objekt.processID)
		objekt.Terminate 0 
		Err.Clear
	Next
	
	' ----------------------------------  
	' Task wieder aus Speicher entfernen	  
	' ----------------------------------  
	
	Set Task = owmi.ExecQuery("select * from win32_process Where Name = 'Winmgmt.exe'")   

	For Each objekt in Task
		 WshShell.AppActivate(objekt.processID)
		 objekt.Terminate 0 
		 Err.Clear
	 Next
	
End Function



Function ErmittleLaufwerksTyp(strLaufwerkstyp) 

	' ------------------------------------------------------------------  
	' Liefert den Typ des Laufwerkes zurück, wo die PST gespeichert ist!  
	' ------------------------------------------------------------------  
	
	 strComputer = "."  
	 
	 SET objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")  
	 SET colItems = objWMIService.ExecQuery("Select * from Win32_logicaldisk")  
	 
	 For Each objItem In colItems
		If objItem.driveType = "4" And  objItem.deviceID = strLaufwerkstyp Then   
			' Netzlaufwerk  
			ErmittleLaufwerksTyp = "Network"  
		ElseIf objItem.driveType = "2" And  objItem.deviceID = strLaufwerkstyp Then   
			' Wechsellaufwerk  
			ErmittleLaufwerksTyp = "Removable"  
		ElseIf objItem.driveType = "3" And  objItem.deviceID = v Then   
			' Lokale Festplatte  
			ErmittleLaufwerksTyp = "Local Disk"  
		End If
	 Next
End Function