Kein Problem.Peter wrote:Guten Abend Holger
ich muss schon wieder betteln gehen...
CreateFolders2.vbs:
Code: Select all
''TotalCommander Button um Verzeichnisse anzulegen
'Kommando : <Pfad>\CreateFolders2.vbs
'Parameter : Template.dir "%P"
'StartPfad : <Pfad>\
'Icondatei : WScript.exe
'Tooltip : Erzeuge Template Verzeichnisse
'Die Vorlagendatei "Template.dir" muss im Verzeichnis "<Pfad>" liegen
' das Platzhalter Zeichen "*" wird durch die abgefragte Zeichenkette ersetzt
'
const sPlaceHolder = "*"
Const FOR_READING = 1
Set oArgs = WScript.Arguments
Dim oFSO
If WScript.arguments.Count > 1 Then
sDirList = oArgs.Item(0)
sDestPath = oArgs.Item(1)
sPrefix = InputBox ("Bitte die Zeichenkette angeben, die das Platzhalterzeichen<*> ersetzen soll"_
,"CreateFolders.vbs"_
,"xxxxxx"_
)
If sPrefix = vbNullString Then WScript.Quit (1)
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists(sDirlist) Then
Set oTextStream = oFSO.OpenTextFile(sDirList,FOR_READING)
Do Until oTextStream.AtEndOfStream
sLine = oTextStream.ReadLine
sLine = Replace(sline,sPlaceholder,sPrefix)
if Not CreateFolders(sDestpath & "" & sLine) then exit do
Loop
oTextStream.Close
Else
WScript.Echo "Input file " & sDirlist & " nicht gefunden."
End If
else
WScript.Echo "Fehlende Parameter"
End If
Function CreateFolders(sPath)
CreateFolders = True
sParentPath = oFSO.GetParentFolderName(sPath)
If Not oFSO.FolderExists(sParentPath) Then
CreateFolders = CreateFolders(sParentPath)
end if
If CreateFolders Then
On Error Resume Next
oFSO.CreateFolder(sPath)
If Not Err.Number = 0 And Not Err.Number = 58 Then
WScript.Echo "Fehler: " & Err.Number &" "& Err.Description & VbCrLf & VbCrLf &_
"Der Pfad" & VbCrLf & VbCrLf &_
sPath & VbCrLf & VbCrLf &_
"konnte nicht angelegt werden."
CreateFolders = False
End If
End If
End FunctionÜbergabeparameter usw. sind die Gleichen geblieben.
Gruß
Holger
Edit: ausführlichere Fehlermeldung und Problem bei bereits existierenden Pfad behoben
