 |
||||||||
 |
 |
 |
||||||
| |
|||||||||||||||||||||||||||||||||||||||||||
 |
 | |||
| Ein Programm in der Programmiersprache | A program in the programming language | |||
| vbScript | ||||
| zur Ermittlung eines anderen Dateinamens, wenn die Datei bereits existiert, zum Sichern in dasselbe Verzeichnis | for getting another filename, if file already exists, for saving into the same folder | |||
Die Prozedur detektiert, ob die spezifizierte Datei bereits existiert, findet einen anderen Namen unter dem noch keine Datei existiert, und gibt ihn zurück zur weiteren Disposition. Normalerweise hängt die Routine eine "1" an in Klammern, das ist: " (1)" und wenn das bereits da ist, dann " (2)" etc., solange bis ein Namen gefunden ist, der nicht vorkommt, aber es berücksichtigt alle möglichen Variationen und Kombinationen von Klammern innerhalb und nach dem Dateinamen und findet einen intelligenten Weg zum Erhalt eines neuen, gut aussehenden Dateinamens, wie zu sehen in einigen Beispielen in der Tabelle unten. Daher ist der Code etwas kompliziert. Aber das Beispiel zeigt das Ausmaß des benötigten Codes. Die Bedingungen für die Inkrementierung der Zahl innerhalb der Klammern sind: 1. Klammer-Ausdruck am Ende des Namens, 2. keine Leerzeichen nach der rechten Klammer, 3. nur Ziffern und keine Leerzeichen innerhalb der Klammern, 4. keine führende Nullen innerhalb der Klammern, 5. ein einzelnes Leerzeichen vor den Klammern, 6. wenn kein Name vor den Klammern, führende Leerzeichen im neuen Namen entfernt. Alle anderen bekommen angehängt " (1)", führende "()" werden entfernt. Wenn die Datei nicht existiert, gibt die Prozedur dieselbe Datei-Spezifikation zurück. | The procedure detects, if the specified file already exists, finds another name, under which no file exists and returns it for further disposition. Normally the routine attaches a "1" in brackets, that is: " (1)" and if it already exists, a " (2)" etc., so long until a filename is found which not occurs, but it regards also all possible variations and combinations of brackets already within and after the filename and finds an itelligent way for getting a new, good looking filename as shown some examples in a table underneath. Therefor the code is a bit complicated. But the example shows the volume of the needed code. The conditions for incrementing the number within the brackets are: 1. bracket-expression at the end of the name, 2. no blanks after the right bracket, 3. only numbers and no blank within the brackets, 4. no leading zeros within the brackets, 5. one single blank before the brackets, 6. if no name before the brackets, leading blank(s) in new name removed. All others get attached a " (1)", preceeding "()" are removed. If file not exists, the procedure returns the same file-specification. | |||
Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist | The program ist tested before publication, but there can be given no guarantee, that it is free of errors | |||
| 17. März 2013 | March 17th 2013 | |||
|
Option Explicit Dim fso, DesiredName, NewName Set fso = CreateObject("Scripting.FileSystemObject") DesiredName = "drive:\path\name.*" NewName = GetUnusedFileNameForSaving(DesiredName) MsgBox "done" Function GetUnusedFileNameForSaving(AnyFileSpec) Dim fSpec, Path, FulName, FileName, Ext, fName, Vary, nr, f Dim i, i1, i2, Numeric: fSpec = AnyFileSpec Do: GetUnusedFileNameForSaving = fSpec If fSpec = "" Then Exit Do If Not(fSpec = FileOnDisk) Then Exit Do Path = fso.GetParentFolderName(fSpec): FulName= fso.GetFileName(fSpec) FileName = fso.GetBaseName(FulName): Ext = "." & fso.GetExtensionName(FulName) Do: fName = RTrim(FileName): Numeric = False If Right(fName, 2) = "()" Then fName = Left(fName,Len(fName)-2): Exit Do fName = FileName: i1 = InStrRev(FileName, "("): i2 = InStrRev(FileName, ")") If i1 = 0 Or i2 = 0 Or i1 > (i2 - 2) Then Exit Do fName = Left(FileName, i1 - 1): If i2 < Len(FileName) Then Exit Do For i = i1 + 1 To i2 - 1 If InStr("0123456789", Mid(FileName, i, 1)) = 0 Then Exit Do Next: If Len(fName) - Len(RTrim(fName)) <> 1 Then Exit Do Numeric = True: nr = Mid(FileName,i1+1,i2-i1-1) Vary = CStr(Eval(nr)): If Vary = nr Then Vary = CStr(Eval(nr) + 1) Loop Until True: f = RTrim(fName) If Right(f, 2) = "()" Then f = Left(f,Len(f)-2) If RTrim(fName) <> f Then fName = f: Vary = "1" If Not Numeric Then Vary = "1" fSpec = fso.BuildPath(Path, RTrim(fName) & " (" & Vary & ")" & Ext) Loop End Function | ||
|
|