Jump to content

Tcossie

Members
 Profil anzeigen  Aktivitäten des Benutzers anzeigen

  • Gesamte Inhalte

    1

  • Registriert seit

  • Letzter Besuch

 Inhaltstyp 

Beiträge erstellt von Tcossie

  1. Ordner mit Abfrage erstellen per vbs

    in Windows Forum — Scripting

    Geschrieben

    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."
×
×
  • Neu erstellen...