Ordner mit Abfrage erstellen per vbs

[Tcossie 0]

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."