Domino 9 und frühere Versionen > ND6: Entwicklung

String zusammensetzen

<< < (4/4)

Thomas Schulte:
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

ctillmanns:
Eine CPU opfern? Bist Du des Wahnsinns keckste Beute? Das ist doch konzentrierte dunkle Macht? Was könnte das auslösen?
Aber Manager geht nicht, da hast Du recht.
Lagerarbeiter gingen noch.

@andrew22: Wenn Du Die Angaben nicht weisst, dann musst Du sie eingeben. FileDialog gibt es ja schon. Notes ist ganz schlecht im Raten. Das muss ich meinen Usern auch im klar machen. Aber Thomas Lösung ist schon mal eine grosse Erleichterung.

andrew22:
fileName = Dir$(basedir & "\*.*",16)

schaut mal das funktioniert ;)

fileName = Dir$("C:\Temp" & "\test*.csv",0)

dat klappt ;)

Navigation

[0] Themen-Index

[*] Vorherige Sete