Ja Directory durchparsen und Pattern suchen. Alles was ins Muster passt wird sich gekrallt.
So was in der Richtung zum Bleistift:
Dim directorylist List As String
Dim startentryposition As Integer
Dim listofdoctypes List As String
Sub Initialize
Dim session As New NotesSession
Dim wksp As New NotesUIWorkspace
Dim folder As Variant
Dim ok As Integer
Dim count As Integer
Dim Basedir As String
Dim extension As String
listofdoctypes("doc") = "doc"
listofdoctypes("xls") = "xls"
listofdoctypes("ppt") = "ppt"
listofdoctypes("txt") = "txt"
listofdoctypes("xlt") = "xlt"
listofdoctypes("dot") = "dot"
listofdoctypes("rtf") = "rtf"
basedir = Inputbox("Basisverzeichnis eintragen","Verzeichnis suchen","i;\")
extension = Inputbox("Erweiterung eintragen","File Extension","xls")
Startentryposition = 0
directorylist(Cstr(startentryposition)) = basedir
Startentryposition = startentryposition + 1
ok = Messagebox ("folgende Daten wurden eingegeben: Verzeichnis " & basedir & " Erweiterung " & extension, 33 , "Diese Daten werden verwendet")
If ok = 1 Then
' at first find all the directories
Call finddirectories(basedir)
' for second get all the files in the previous found directories and rename them
For Count = 0 To startentryposition-1
Call renamefiles(directorylist(Cstr(Count)),extension)
Next
Else
Messagebox "Verarbeitung wurde abgebrochen", 16 , "ACHTUNG"
End If
End Sub
Sub finddirectories(basedir As String)
' finds all directory entries and subentries in a given path
Dim filename As String
Dim fileattribute As Integer
Dim isdir As Integer
Dim fromcount As Integer
Dim setfirstentryposition As Integer
Dim setlastentryposition As Integer
Dim dircount As Integer
Dim i As Integer
On Error Resume Next
' save the entryposition due to the recursion
setfirstentryposition = startentryposition
' get the file names
fileName = Dir$(basedir & "\*.*",16)
Do While fileName$ <> ""
fileattribute = Getfileattr (basedir + "\" + fileName )
If fileattribute = 16 Then
' check if this is really a directory
isdir = checkdir(basedir + "\" + Filename)
If isdir = True Then
If filename <> "." And filename <> ".." Then
directorylist(Cstr(startentryposition)) = basedir & "\" & Filename
startentryposition = startentryposition + 1
End If
End If
End If
filename = Dir$()
Loop
If setfirstentryposition < startentryposition Then
setlastentryposition = startentryposition
For i = setfirstentryposition To setlastentryposition -1
Call finddirectories(directorylist(Cstr(i)))
Next
End If
End Sub
Function checkDir( path As String ) As Integer
On Error Resume Next
CheckDir = False
Chdrive Left( path, 1 )
Chdir path
If Curdir = path Then
CheckDir = True
End If
End Function
Sub renamefiles(basedir,extension)
Dim filename As String
' renames the files, appends the previous named extension if there is no other extension
' check if the 4 entry from the right side is a point
' get the file names
fileName = Dir$(basedir & "\*.*",0)
Do While fileName$ <> ""
If Left(Right(filename,4),1) = "." Then
If Not Iselement(listofdoctypes(Lcase(Right(filename,3)))) Then
Name basedir & "\" & Filename As basedir & "\" & filename & "." & Extension
End If
Else
Name basedir & "\" & Filename As basedir & "\" & filename & "." & Extension
End If
filename = Dir$()
Loop
End Sub
