lange Zeit ist mein Katalogprogramm, auch im Forum veröffentlicht,
problemlos gelaufen.
Jetzt bekomme ich bei einigen Directorys folgende Fehlermeldung.
Zur Fehlerprüfung lege ich einmal das Programm bei:
Code: Alles auswählen
Sub Verzeichnis_und_Unterverzeichnisse
'*************************************************************
'**** Katalog eines Ablageortes mit Unterverzeichnissen ******
'**** sortiert nach Verzeichnissen und Dateiendungen ******
'**** Anregungen stammen aus dem Openoffice- und ******
'**** LibreOffice-Forum. ******
'**** Die Programmsequenzen stammen ebenso von dort. ******
'**** Somit möchte ich mich mit diesem Macro bei ******
'**** allen aktiven Anwendern, deren Können und Wissen ******
'**** ich begierig aufgegriffen habe, bedanken. ******
'**** Mit Grusz Werner Gatzweiler ******
'*************************************************************
'*
Dim Liste(10000) as string
Dim Desktop as object
Dim Mappe as object
Dim Tabelle as object
Dim oColumn As Object
Dim oFolderPicker as object
Dim TeilStrings() as string
Dim TeilString as String
Dim sNamen As String
Dim sPath as String
Dim i as long
dim z as long
Dim j as Integer
Dim n as Integer
Dim Zahl as Integer
Dim dummy()
Dim SortProps(2) As new com.sun.star.beans.PropertyValue
Dim SortFeld(1) As new com.sun.star.table.TableSortField
oFolderPicker = createUnoService("com.sun.star.ui.dialogs.FolderPicker")
oFolderPicker.execute
sPath = ConvertFromUrl(oFolderPicker.directory & "/") 'das Hauptverzeichnis
erg=getDirs(liste(),0,sPath) 'Anzahl der Ergebnisse
Desktop = CreateUnoService ("com.sun.star.frame.Desktop")
Mappe = Desktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, dummy())
Tabelle = Mappe.getSheets().getbyIndex(0)
' Kopfzeile der Tabelle beschreiben
Tabelle.getCellbyPosition(0,0).string = sPath 'Der Hauptpfad
Tabelle.getCellbyPosition(1,0).string = "Dateipfad"
Tabelle.getCellbyPosition(2,0).string = "Dateiname"
Tabelle.getCellbyPosition(3,0).string = "Dateityp"
Tabelle.getCellbyPosition(4,0).string = "Dateiaufruf"
i = 1
Do While i<erg
Teilstrings() = Split(liste(i),"/")
'nachfolgend der Dateipfad
'MsgBox UBOUND(Teilstrings) + 1 ' ergibt die Größe des Array
'msgbox liste(i)
sName=""
j=0
Do While j < UBOUND(Teilstrings)
sName = Trim(sName + Teilstrings(j)+"/")
j=j+1
Loop
'msgbox sName
'nachfolgend das Schreiben von Hyperlink
Tabelle.getCellbyPosition(1,i).formulaLocal = "=HYPERLINK("+chr(34)+ConvertFromURL(sName)+chr(34)+")"
'nachfolgend das Auslesen des Dateitypes
On Error Resume next 'Ist nötig, wenn kein Teilstring durch "." gefunden wird.
'sName() = Split(liste(i),".",Anzahl)
'msgbox Anzahl
'Anzahl abfragen funktioniert nicht
sName() = Split(liste(i),".")
n = UBOUND(sName()) + 1 ' ergibt die Größe des Array
Tabelle.getCellbyPosition(3,i).string = Trim(sName(n-1)) 'Dateitype
'nachfolgend das Auslesen des Dateinamens
Teilstrings() = Split(sName(0),"/")
'msgbox sName(0)
j=UBOUND(Teilstrings)
Tabelle.getCellbyPosition(2,i).string = ConvertFromURL(Trim(TeilStrings(j)))
'nachfolgend das Schreiben von Hyperlink
'Tabelle.getCellbyPosition(4,i).formulaLocal = "=HYPERLINK("+Tabelle.getCellbyPosition(1,i).AbsoluteName+")"
'msgbox chr(34)
Tabelle.getCellbyPosition(4,i).formulaLocal = "=HYPERLINK("+chr(34)+Tabelle.getCellbyPosition(1,i).string+Tabelle.getCellByPosition(2,i).string+"."+Tabelle.getCellbyPosition(3,i).string+chr(34)+")"
i = i + 1
Zahl = i
Loop
msgbox "Verzeichnis mit Unterordner wurde eingelesen !"
msgbox "Tabelle wird formatiert"
'Jetzt wirden die Spalten der Tabelle auf optimale Breite gesetzt
i=0
Do while i<5 'in diesem Beispiel gibt es nur 5 Spalten
oColumn = Tabelle.getColumns.getByIndex(i)
'Schriftwahl und Schriftgröße
oColumn.CharFontName="Comic Sans MS"
oColumn.CharHeight="10"
' optimal width
oColumn.setPropertyValue("OptimalWidth", True)
i = i+1
Loop
'Die Kopfzeile wird formatiert
Tabelle.getCellRangeByName("A1:E1").CharFontName="Comic Sans MS"
Tabelle.getCellRangeByName("A1:E1").CharHeight="12"
Tabelle.getCellRangeByName("A1:E1").CharWeight=com.sun.star.awt.FontWeight.BOLD
Tabelle.getCellRangeByName("A1:E1").horijustify=2 'Kopfzellen zentrieren
Antwort = Zahl-1 'Kopfzeile abgezogen
Print "Es gibt " + Antwort + " Dateien"
Print "Diese " + Antwort + " Dateien werden jetzt nach Ablageort und Dateiendung sortiert!"
'Beginn der Sortierung
SortierBereich = Tabelle.getCellRangeByName("B1:E"+Zahl)
SortFeld(0).Field = 0
SortFeld(0).IsAscending = True
SortFeld(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
SortFeld(1).Field = 2
SortFeld(1).IsAscending = True
SortFeld(1).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
SortProps(0).Name = "SortFields"
SortProps(0).Value = SortFeld()
SortProps(1).Name = "SortColumns"
SortProps(1).Value = False
SortProps(2).Name = "ContainsHeader"
SortProps(2).Value = true 'Die erste Zeile (Überschrift) wird nicht mit sortiert!
SortierBereich.Sort(SortProps())
Print "Die Sortierung ist beendet"
End Sub
'********** FUNKTIONEN *********************
FUNCTION CUTTER(LongText as string, Part as integer, optional Sign as string )
On Error Goto ErrorHandler
If IsMissing (Sign) Then
Sign = "/"
end if
TextParts = Split(LongText, sign)
CUTTER = TextParts (part)
exit Function
ErrorHandler:
CUTTER = "#NV"
End FUNCTION
function getdirs( liste(),z, folder) as integer
sFolderUrl = ConvertToUrl( Folder )
oSimpleFileAccess = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )
aFolders = oSimpleFileAccess.getFolderContents( sFolderUrl,true )
For i = LBound( aFolders ) To UBound( aFolders )
sFile = aFolders( i )
If oSimpleFileAccess.isFolder( sFile ) Then
getdirs( liste(),z, sFile)
Else
liste(z)=sFile
z=z+1
end if
next i
getdirs=z
end function
Werner