OrdnerInhalt per VBS in frei definierbaren Ordner kopieren

'Variablen werden deklariert  
dim fd, fs, a, x, f1
'Benötigte Objekte für die Netzwerkfreigabe  
dim objFSO, objWMIService, objNewShare

'Objekt für die Überprüfung, ob Ordner Existiert  
set fd = CreateObject("Scripting.FileSystemObject")  

'Eingabebox Quellverzeichnis  
x = inputbox("Gib Quellverzeichniss an! bsp. c:\bla")  
'Wenn Datei nicht Existiert dann MsgBox mit hinweis!  
if not fd.folderexists (""& x) Then  
Yantwort = msgbox ("Die Ordner Existiert nicht!", vbOkCancel + vbQuestion, "Was tun?")  
	
	'Wenn Antwort Ok, dann Quellverzeichnis Neueingabe  
	if Yantwort = vbOK Then
	x = inputbox("Gib Quellverzeichniss an! bsp. c:\bla")  
	End If
	
'Einagabebox Zielverzeichnis  
a = inputbox("Gib den Namen des Ordners an!")  

'Objekte werden erstellt  
set fs = CreateObject("Scripting.FileSystemObject")  
'Variable der zu kopierenden Datei  
Set CF = CreateObject("Scripting.FileSystemObject")  
'Objekt zum löschen des vorhandenen Ordners  
Set objFSO = CreateObject("Scripting.FileSystemObject")  

'Wenn abfrage, wenn der Ordner existiert, wie vorgehen  
	if fs.folderexists ("d:\"& a) Then  
	antwort = MsgBox("Der Ordner """ &a& """ Existiert bereits!" & vbCR & VbCR &_  
	"Ja = Vorhandenen Ordner Löschen und neuen anlegen!" & vbCR & vbCR &_  
	"Nein = Weiter Möglichkeiten!" & vbCR & vbCR & _  
	"Abbrechen = Is klar, ne?!", vbYesNoCancel + vbQuestion, "Was tun?")  
	
	'Wenn Abfrage, wenn Antwort "JA", dann alten Ordner löschen, Neuen erstellen und Daten kopieren  
		if antwort = vbYes Then
		objFSO.DeleteFolder("d:\" & a)  
		fs.createfolder("d:\" & a)  
		CF.CopyFile ""&x, "d:\" & a & "\"  
		msgbox "Alter Ordner weg, Neuer Ordner """ &a& """ da incl. Dateien und im Netz freigeben!"  
		'Wenn "NEIN", dann weiter Möglichkietn. Namen neu eingeben, In bestehenden Ordner alles Kopieren  
		elseif antwort = vbNo Then
		Xantwort = msgbox("Abbrechen = Is klar, ne?!"& vbCR & vbCR & _  
		"Wiederholen = Zurück zur Inputbox und neuen Namen angeben" & vbCR & vbCR & _  
		"Ignorieren = Namenseingabe Ignorieren und Daten ins bestehenden Verzeichnis kopieren und im Netz freigeben", _  
		vbAbortRetryIgnore + vbExclamation, "Was nun?")  
		End If
			
			'Wenn Abfrage bei weiteren Möglichkeiten. Wenn "JA", neuen Namen für Ordner eingeben, Ordner erstellen und Daten kopieren  
			if Xantwort = vbRetry Then
			a = inputbox("Gebe den Namen des Ordners an!")  
			fs.createfolder("d:\" & a)  
			CF.CopyFile ""&x, "d:\" & a & "\"  
			msgbox "Der neue Ordner """ &a& """ wurde angelegt und Dateien kopiert und im Netz freigeben!"  
			'Bei "NEIN", Daten in vorhanden Ordner rein Kopieren  
			elseif Xantwort = vbIgnore Then
			CF.CopyFile ""&x, "d:\" & a & "\"  
			msgbox "Dateien wurden in den vorhandenen Ordner """ &a& """ kopiert und im Netz freigeben!"  
			End If

'Wenn Ordner nicht Vorhanden, Neuen erstellen und Daten Kopieren  
else
fs.createfolder("d:\" & a)  
CF.CopyFile ""&x, "d:\" & a & "\"  
msgbox "Der Ordner """ &a& """ wurde angelegt und Dateien kopiert und im Netz freigeben!"  

End If

'Konstanten für Netzwerkfreigabe, zulässige gleichzeitige Zugriffe  
Const FILE_SHARE = 0
Const MAXIMUM_CONNECTIONS = 25

'Name des PC wird aus der Registry rausgelesen  
strComputer = "."  

'Verbidnung mit WMI wird hergestellt  
Set objWMIService = GetObject("winmgmts:" _  
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")  

'Ordner wird freigegeben, Freigabe name, ist der Ordnername, Kommentar "Meine Freigabe" wird in Eigenschaften eingetragen  
Set objNewShare = objWMIService.Get("Win32_Share")  
errReturn = objNewShare.Create _
    ("d:\"& a, ""& a,  FILE_SHARE, _  
        MAXIMUM_CONNECTIONS, "Meine Freigabe")  

End If