Werte Script'ler
bin neu in diesem Forum und hoffe, dass ich die Konventionen einhalte.
ich möchte beil. Script mit msgBox erweitern bzw. auch einen Unterordner mit der ersten Abfrage erstellen. Im Moment erstellt das Script im Verz. D:\\Daten Projekt den in der Abfrage erzeugten Namen in der gleichen Ebene.
Ich hatte dieses Script noch vor meiner Erblindung geschrieben, nun komme ich einfach nicht mehr weiter(schon 5 J. keine prg. mehr erst.).
Ich hoffe auf Euch....es ist dringend...vielen Dank im Voraus.
Anbei Script:
' Region Description
'
' Name: Ordner erstellen
' Author: Tcossie
' Version: 06
' Description:
'
'
' EndRegion
Const Ordner = "Bitte geben Sie den neue Projektnamen ein:"
Const Titel = "Aufforderung für Projektnamen"
Const Wert = "Hier den neuen Projektnamen eingeben"
Const cVBS = "generate_folder.vbs"
Const cSUB1 = "BETRIEBS- UND WARTUNGSANLEITUNG,MASSBILD DATENBLATT SCHEMATAS,PROJEKTANTRAG,ENTWICKLUNG,TYPENPRÜFUNG" ' Hier die Stammordner angeben
Const cSUB2 = "Unterordner 1,Unterordner 2,Unterordner 3,Unterordner 4" ' Unterordner
Const cSUB3 = "Wahlordner 1,Wahlordner 2,Wahlordner 3,Wahlordner 4" ' Diese Ordner werden nur auf Wunsch erstellt
'****
' Nach dem Ordner D:\Daten Projekte sollter das Script einen Unterordner mit der bestehenden MsgBOX erstellen(shit bring's nicht fertig!!!!!!!!!)
Const cFOL = "D:\DATEN PROJEKTE"
'**
Const cSHELL = "\Unterordner 1" ' In den Ordner sollen die Wahlordner kommen
Const eTechnik = "\Ordner 1"
Const msr = "\Ordner 2"
Const TIMEOUT = 0
Const POPUP="RM Ordner anlegen"
Dim Input
Dim strFOL
Dim arrSUB
arrSUB = Split(cSUB, ",")
Dim arrSUB1
arrSUB = Split(cSUB1,",")
Dim intSUB
Dim strSUB
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objGFO
Dim objGFO2
Dim objFOL
Dim objFOL2
Dim objShell
'#########################################################
' Existenzabfrage
'****
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Do While OK = False
Input=InputBox(Ordner,Titel)
If Input ="" Then WScript.Quit
If (fso.FolderExists(cFOL + Input)) Then
msg = "Ordner "& Input & " existiert schon."
MsgBox (msg)
Else
Set f = fso.CreateFolder(cFOL + Input)
f.Path
Exit Do
End If
Loop
'****
' Ordner 1, Ordner 2, Ordner 3 anlegen
'****
'*
'* Add Subfolders
'*
Set objGFO = objFSO.GetFolder(cFOL)
Set objFOL = objGFO.SubFolders
If objFSO.FolderExists(cFOL+Input) Then
For intSUB = 0 To UBound(arrSUB)
'* For intSUB = 8 - zeigt die Ordnerbeschriftung(Const cSUB2)
strSUB = arrSUB(intSUB)
WScript.Echo cFOL & Input & "\" & strSUB
objFSO.CreateFolder(cFOL & Input & "\" & strSUB)
Next
End If
'****
'****
'* Unterordner in Ordner1 anlegen
'****
'*
'* Add Subfolders1
'*
Set objGFO = objFSO.GetFolder(cFOL+Input+eTechnik)
Set objFOL = objGFO.SubFolders
'*
'* Add Subfolders
'*
If objFSO.FolderExists(cFOL+Input) Then
For intSUB = 0 To UBound(arrSUB1)
strSUB = arrSUB1(intSUB)
objFSO.CreateFolder(cFOL & Input & "\" & eTechnik & "\" & strSUB)
Next
End If
'****
'****
' Unterordner in Ordner2 anlegen
'****
'*
'* Add Subfolders2
'*
Set objGFO2 = objFSO.GetFolder(cFOL+Input+eTechnik)
Set objFOL2 = objGFO2.SubFolders
'*
'* Add Subfolders
'*
If objFSO.FolderExists(cFOL+Input) Then
For intSUB = 0 To UBound(arrSUB2)
strSUB = arrSUB2(intSUB)
objFSO.CreateFolder(cFOL & Input & "\" & eTechnik & "\" & strSUB)
Next
End If
'****
' Unterordner in Ordner 3 anlegen
'****
'*
'* Add Subfolders3
'*
Set objGFO2 = objFSO.GetFolder(cFOL+Input+msr)
Set objFOL2 = objGFO2.SubFolders
'*
'* Add Subfolders
'*
If objFSO.FolderExists(cFOL+Input) Then
For intSUB = 0 To UBound(arrSUB2)
strSUB = arrSUB2(intSUB)
objFSO.CreateFolder(cFOL & Input & "\" & msr & "\" & strSUB)
Next
End If
'****
'*
If objFSO.FolderExists(cFOL+Input) Then
For intSUB = 0 To UBound(arrSUB2)
strSUB = arrSUB2(intSUB)
objFSO.CreateFolder(cFOL & Input & "\" & msr & "\" & strSUB)
Next
End If
'############## Wahlordner anlegen ???? ##################
Set objShell = WScript.CreateObject("WScript.Shell")
iRetVal = objShell.Popup ("Sollen die RM Ordner angelegt werden?",,POPUP,vbExclamation+vbYesNo)
If iRetVal = 0 Then
Set objGFO1 = objFSO.GetFolder(cFOL+Input+msr+cSHELL)
Set objFOL1 = objGFO1.SubFolders
'*
'* Add Subfolders
'*
If objFSO.FolderExists(cFOL+Input) Then
For intSUB = 0 To UBound(arrSUB2)
strSUB = arrSUB2(intSUB)
objFSO.CreateFolder(cFOL & Input & "\" & msr & cSHELL & "\" & strSUB)
Next
End If
End If
'*
'* Destroy Objects
'*
Set objFOL = Nothing
Set objGFO = Nothing
Set objFSO = Nothing
'*
'* Finish
'*
MsgBox "Alle Ordner wurden angelegt."
