[gelöst] Wie vermeide ich den Ueberlauffehler?

Alles zur Programmierung im LibreOffice.
wega
Beiträge: 50
Registriert: Mi 16. Jul 2014, 19:15

[gelöst] Wie vermeide ich den Ueberlauffehler?

Beitrag von wega » So 7. Jan 2018, 18:52

Hallo zusammen,

lange Zeit ist mein Katalogprogramm, auch im Forum veröffentlicht,
problemlos gelaufen.

Jetzt bekomme ich bei einigen Directorys folgende Fehlermeldung.
Fehlermeldung.jpg
Fehlermeldung.jpg (36.48 KiB) 438 mal betrachtet
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

Mit Gruß
Werner
Zuletzt geändert von wega am Sa 20. Jan 2018, 20:16, insgesamt 1-mal geändert.



balu
Beiträge: 274
Registriert: Mi 1. Jun 2011, 16:21

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von balu » Mo 8. Jan 2018, 13:52

Hallo Werner,
Jetzt bekomme ich bei einigen Directorys folgende Fehlermeldung.
Fehlermeldung hat geschrieben: Index außerhalb des definierten Bereichs.
Eigentlich hast Du alles an Informationen um selber dahinter zu kommen. Aber nun gut, gehen wir mal die Sache systematisch durch.

Dein Problem tritt nicht immer auf, sondern nur in bestimmten Situationen. Also ist dein Code nicht vollständig inkorrekt. Das ist schon mal sehr gut, zwecks Fehleranalyse.

Du hast nicht nur die Fehlermeldung abgeknipst, sondern auch die Stelle wo es zur Fehlermeldung kommt, auch das hilft bei der Fehleranalyse.

Und jetzt sagt die Fehlermeldung auch ausnahmaweise genau das, was sie meint. Zusätzlich wird diese Zeile angemääääckert.

Code: Alles auswählen

liste(z)=sFile
liste hat einen Indexzähler (z), der bei jedem Schleifendurchlauf hochgezählt wird.
Das Dumme an der ganzen Sache ist aber, das Du in der Sub Verzeichnis_und_Unterverzeichnisse die Variable liste wie folgt deklariert hast.

Code: Alles auswählen

Dim Liste(10000) as string
Und dadurch kann das Array liste maximal 10001 Einträge aufnehmen. Dies Array ist Null-basierend, geht also von 0 bis 10000, was dann die 10001 Einträge ausmacht.

In der Function getdirs wird ja durch

Code: Alles auswählen

aFolders = oSimpleFileAccess.getFolderContents( sFolderUrl,true )
ein Array eingelesen, welches eine bestimmte größe hat. Und die obere Grenze dieses Arrays wird ja mit UBound(aFolders) ausgelesen. Und wenn die Obere Grenze z.B. bei 10002 liegt, dann kommt es automatisch in dieser Schleife

Code: Alles auswählen

   For i = LBound( aFolders ) To UBound( aFolders )
zu der Fehlermeldung. Denn das Array liste ist ja auf 10000 Einträge (Null-basierend) festgelegt, aber nicht für mehr.
Wie sollen also z.B. 10002 Datensätze in eine Liste mit maximal 10000 Zeilen? Das geht halt nicht.

Die einfachste Lösung deines Problems sähe wie folgt aus.

Code: Alles auswählen

Dim Liste(100000) as string
Einfach ein 0 dazu, und schon hast Du Platz für 100.000 Datensätze.

Und ja, ich konnte dein Problem nachstellen, und durch die zusätzliche 0 verschwand das Problem. Getestet mit LO 5.1.5.2.

Aber ob das nun die eleganteste Methode ist, ist eine andere Frage. Denn was machst Du, wenn Du mal auf ein Verzeichnis stößt das 100010 Dateien hat? Dann musst Du ja wieder die Array deklaration ändern. Da gäbe es bestimmt bessere Methoden das zu umgehen. Aber fürs erste soll das wohl reichen.



Gruß
balu

balu
Beiträge: 274
Registriert: Mi 1. Jun 2011, 16:21

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von balu » Mo 8. Jan 2018, 21:29

Hallo Werner,

falls Du an einer Lösung interessiert bist, in der man nicht andauernd

Code: Alles auswählen

Dim Liste(10000) as string
ändern muss, dann hätte ich da jetzt etwas für dich.

Die Function getdirs habe ich minimal so ergänzt, das sie jetzt 2 Aufgaben übernehmen kann.

Die 1. ist.
Ermittle nur die Anzahl an Dateien.
Dabei spielt die Variable 'liste' keine Rolle.

Die 2. ist.
So wie Du sie halt kennst.

Dazu musste ich den Namen der Function wie folgt erweitern.

Code: Alles auswählen

function getdirs( liste(), schalter, z, folder) as integer
Es ist hinzugekommen: schalter
Die Function wird also nicht nur einmal aufgerufen. Das bedeutet allerdings, das sich die Makroausführung zeitlich etwas verlängert, je nach Größe des einzulesendem Verzeichnis.

Das war aber noch nicht alles. Denn auch der Aufruf der Function hat sich geändert.
Neu.

Code: Alles auswählen

erg=getDirs(liste(), 0, 0, sPath)
Hier jetzt mal der gesamte geänderte Code.
An den stellen wo ich etwas geändert habe, habe ich einen Kommentar dazu geschrieben.

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 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

'########################################################################### Änderung beginn.
'##
iAnzahlDateien = getDirs(liste(),1, 0, sPath) 'Anzahl der Dateien. Die 1 ist für den "Schalter"

Dim Liste (iAnzahlDateien) as String ' hier ist die neue Stelle für die Variablen deklaration.

erg=getDirs(liste(), 0, 0, sPath) 'Jetzt wird der "Schalter" auf 0 zurück gesetzt.
								  'Und die eigentliche Arbeit kann beginnen.
'##
'########################################################################### Änderung ende.

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 !"
print "Verzeichnis mit Unterordner wurde eingelesen !"

'msgbox "Tabelle wird formatiert"

print "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(), schalter, 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(), schalter, z, sFile)
      Else
      	if schalter = 1 then ' Wenn schalter = 1, 
       		z = z +1	     ' dann wird nur der Zähler z hochgezählt
      		goto Endschalter ' anschließend wird zur Sprungmarke "Endschalter" gesprungen.
      	end if
        liste(z)=sFile
        z=z+1
        Endschalter:    ' Hier ist die Sprungmarke. Und weiter gehts.
     end if  
   next i      
   getdirs=z
end function
Wenn noch Fragn sind, nur zu. 8-)



Gruß
balu

wega
Beiträge: 50
Registriert: Mi 16. Jul 2014, 19:15

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von wega » Fr 12. Jan 2018, 15:28

Hallo balu,

vielen Dank für Deine Anmerkungen und Ausführungen.
Da ich im Moment umziehe habe ich nicht immer einen Zugriff
auf den Rechner und Internet. Daher die etwas längere Pause.

Die Anweisung

Code: Alles auswählen

Dim Liste(10000) as string
habe ich auch immer um jeweils eine Null bzw auch schon mal
um einen höheren Wert ersetzt.
Aber wie Du schon schreibst, ist das nervig und auch keine
richtige (elegante) Lösung.

Deinen 2. Vorschlag, mit dem Schalter, habe ich noch nicht
ganz verstanden; werde mich aber damit auseinandersetzen,
da dies richtiger ist, als eine NULL anzusetzen.

Ich habe den modifizierten Quellcode eingelesen und erhalte dennoch
die Fehlermeldung:
Fehlermeldung-02.jpg
Fehlermeldung-02.jpg (36.26 KiB) 349 mal betrachtet
bei der Nutzung von:
LibreOffice
Version: 5.4.4.2
Build-ID: 2524958677847fb3bb44820e40380acbe820f960
CPU-Threads: 2; BS: Windows 6.1; UI-Render: Standard;
Gebietsschema: de-DE (de_DE); Calc: group

In der Hofnung, nicht zu nerven,
mit Gruß
Werner

PS: Eventuell handelt es sich hier um einen Fehler in Libreoffice BASIC.
Denn mit einer Fehlerabfrage (On Error goto ...) habe ich festgestellt,
dass der Fehler bei einem Wert von z über 32768 auftritt. Und das
ist genau der Endzahlenwert von INTEGER.
Durch eine Dimensionierung (Dim z as long) ist es mir nicht gelungen den
Zahlenbereich zu vergrößern. Fehlerausstoß -> wieder bei größer 32768.

Eigendlich sollte mit der Dimensionierung aber folgendes erreicht werden:
Integer: Integer-Variable (-32768 - 32767)
Long: Long Integer-Variable (-2.147.483.648 -2.147.483.647)

Setzte ich in dem Makro irgendwie z immer wieder auf Integer zurück?

Nochmals Gruß
Werner

musikai
Beiträge: 158
Registriert: Do 14. Mai 2015, 17:53

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von musikai » Sa 13. Jan 2018, 17:07

Hi,
z ist ja als long definiert, aber die Funktion
getdirs( liste(),z, folder) as integer
definierts dann als integer. Also besser das integer weglassen.

Balu's Lösung kriegt 100 Punkte für Kreativität. Allerdings verschiebt sie nur das Problem.
Anstatt am Anfang das Array Liste() mit 1000 zu dimensionieren, kann man es leer lassen und in der Funktion getdirs an die echten Werte anpassen mit

Code: Alles auswählen

redim preserve Liste(z) 
Ansonsten habe ich noch festgestellt, dass das Programm nicht zurechtkommt mit Dateinamen ohne Endung und durcheinanderkommt mit Pfaden mit "." oder Dateinamen mit mehreren ".".
Am besten man lädt am Anfang die von LibreOffice sest mitgelieferte "Tools"-Bibliothek und macht von nützlichen Helfern Gebrauch:

Code: Alles auswählen

Sub NetteHelfer
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then GlobalScope.BasicLibraries.LoadLibrary("Tools")
sPath = convertfromurl("C:\Users\kai\Desktop\Dokument ö.pdf")
sFilename=FileNameoutofPath(sPath,getpathseparator())
sFilenameonly=GetFileNameWithoutExtension(sFilename)
sExtension=GetFileNameExtension(sPath)
sDirectory=DirectoryNameoutofPath(sPath,getpathseparator())
Directoryarray=split(sDirectory,getpathseparator())
sDirectoryName=Directoryarray(ubound(Directoryarray))
msgbox "OrdnerPfad: " & sDirectory & chr(10) & "OrdnerName: " & sDirectoryName & chr(10) & "DateiName: " & sFilenameonly & chr(10) & "Datei-Typ: " & sExtension
End Sub
Hier mal Dein Programm leicht abgeändert. (Ich hoffe, ich habe alle Stellen gefunden, die das Limit verursacht hatten)

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() 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 long
Dim dummy()
Dim SortProps(2) As new com.sun.star.beans.PropertyValue
Dim SortFeld(1) As new com.sun.star.table.TableSortField
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then GlobalScope.BasicLibraries.LoadLibrary("Tools")
oFolderPicker = createUnoService("com.sun.star.ui.dialogs.FolderPicker")
oFolderPicker.execute
sPath = ConvertFromUrl(oFolderPicker.directory) 'das Hauptverzeichnis
if len(sPath)=0 then
exit sub
end if

sPath=sPath & getpathseparator
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

   sName=ConvertFromURL(liste(i))
   DateiNameVoll=FileNameoutofPath(sName,getpathseparator())
   DateiName=GetFileNameWithoutExtension(DateiNameVoll)
   Dateityp=GetFileNameExtension(sName)
   if Dateityp=sName then Dateityp=""  'falls Datei keine Endung hat
   DateiPfad=DirectoryNameoutofPath(sName,getpathseparator())
   
   
   Tabelle.getCellbyPosition(1,i).formulaLocal = "=HYPERLINK("+chr(34)+DateiPfad+getpathseparator()+chr(34)+")"
   
   Tabelle.getCellbyPosition(3,i).string = Dateityp 'Dateitype
   
   Tabelle.getCellbyPosition(2,i).string = DateiName
 
   Tabelle.getCellbyPosition(4,i).formulaLocal = "=HYPERLINK("+chr(34)+sName+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


function getdirs( liste(),z, folder) 
   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
      	redim preserve liste(z)
        liste(z)=sFile
        z=z+1
     end if  
   next i      
   getdirs=z
end function
Win7 Pro, Sibelius 7.1.3, Lubuntu 15.10, LibO 4.4.7, OO 4.1.3
Free Project: LibreOffice Songbook Architect (LOSA)
http://struckkai.blogspot.de/2015/04/li ... itect.html

wega
Beiträge: 50
Registriert: Mi 16. Jul 2014, 19:15

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von wega » Sa 13. Jan 2018, 18:15

Hallo musikai,

Danke für Deine Antwort.
Durch die Helferlein scheint sich das Makro ja enorm zu kürzen.
Ich versuche es einmal zu verstehen und melde mich bei Fragen
nochmals.

Mit Gruß
Werner

wega
Beiträge: 50
Registriert: Mi 16. Jul 2014, 19:15

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von wega » Sa 13. Jan 2018, 19:43

Hallo balu, hallo musikai,

Dank eurer Hilfe ist das Makro richtig schlank und transparent geworden.

jedoch ist mir erst jetzt aufgefallen, dass durch "getFolderContents( sFolderUrl,true )"
nicht alle Unterverzeichnisse dargestellt werden.
Bei meinen Versuchen nur immer das Erste, das gefunden wurde. Jedoch in dem dann
alle Dateien.

Mit "getFolderContents( sFolderUrl,false )" werden nur die Dateien im Hauptverzeichnis
wiedergegeben.

Wie aber muß ein LOOP aufgebaut werden, damit alle Unterverzeichnisse inklusive den
darin enthaltenen Dateien aufgelistet werden?

Mit Gruß
Werner

musikai
Beiträge: 158
Registriert: Do 14. Mai 2015, 17:53

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von musikai » Sa 13. Jan 2018, 21:56

Bist Du Dir sicher? Bei mir zeigt es alle Unter-Ordner an. Habs allerdings mit diesem upgedatetem Code hier getestet.
Darin habe ich die ein bißchen noch was geändert, sodass auch root-Pfade wie C:\ verarbeitet werden können sollten. (Allerdings konnte ich das nicht bis zum Schluss testen, weil es so ewig lang dauert auf meinem superschlapp-Laptop.)

Weitere Änderung: Wenn das Programm die gefundenen Dateien in die Tabelle schreibt, dauert das ja immer recht lang. Verantwortlich dafür ist die langsame GUI. Für diesen Vorgang habe ich das Screenupdate ausgeschaltet mit

Code: Alles auswählen

ThisComponent.LockControllers
Und danach wieder an mit

Code: Alles auswählen

ThisComponent.UnLockControllers
So geht's bedeutend schneller. Wichtig sind die Errorhandler. Falls bei diesem Vorgang was schiefgeht, muss man es wieder einschalten

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() 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 long
Dim dummy()
Dim SortProps(2) As new com.sun.star.beans.PropertyValue
Dim SortFeld(1) As new com.sun.star.table.TableSortField
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then GlobalScope.BasicLibraries.LoadLibrary("Tools")
oFolderPicker = createUnoService("com.sun.star.ui.dialogs.FolderPicker")
oFolderPicker.execute
sPath = ConvertFromUrl(oFolderPicker.directory) 'das Hauptverzeichnis
if len(sPath)=0 then
exit sub
elseif len(sPath)>3 then
sPath=sPath & getpathseparator
end if
rem msgbox countmainfolders(sPath)
rem exit sub
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"

	  on error goto errorhandler1 
      rem----screenupdating turned off 
      ThisComponent.LockControllers
i = 1

Do While i<erg

   sName=ConvertFromURL(liste(i))
   DateiNameVoll=FileNameoutofPath(sName,getpathseparator())
   DateiName=GetFileNameWithoutExtension(DateiNameVoll)
   Dateityp=GetFileNameExtension(sName)
   DateiPfad=DirectoryNameoutofPath(sName,getpathseparator())
   
   
   Tabelle.getCellbyPosition(1,i).formulaLocal = "=HYPERLINK("+chr(34)+DateiPfad+getpathseparator()+chr(34)+")"
   
   Tabelle.getCellbyPosition(3,i).string = Dateityp 'Dateitype
   
   Tabelle.getCellbyPosition(2,i).string = DateiName
 
   Tabelle.getCellbyPosition(4,i).formulaLocal = "=HYPERLINK("+chr(34)+sName+chr(34)+")"
   
   i = i + 1
   Zahl = i
Loop

      rem----screenupdating turned on 
      ThisComponent.UnLockControllers
	  on error goto errorhandler2       
    
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"
exit sub
errorhandler1:
rem----screenupdating turned on
ThisComponent.UnLockControllers
msgbox error
exit sub
errorhandler2:
msgbox error
End Sub

function getdirs( liste(),z, folder) 
	on error goto skip
   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
      	redim preserve liste(z)
        liste(z)=sFile
        z=z+1
     end if  
   next i    
skip:
   getdirs=z
end function
Win7 Pro, Sibelius 7.1.3, Lubuntu 15.10, LibO 4.4.7, OO 4.1.3
Free Project: LibreOffice Songbook Architect (LOSA)
http://struckkai.blogspot.de/2015/04/li ... itect.html

wega
Beiträge: 50
Registriert: Mi 16. Jul 2014, 19:15

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von wega » So 14. Jan 2018, 14:14

Hallo musikai,

das ist wie verhext.
Ich lege einmal einen gezippten Ordner mit Unterordnern
und Dateien bei. Alles sehr kurz gehalten, um zu einem
schnellen Ergebnix zu kommen.

Bei diesem Beispiel zeigt sich bei mir kein Resultat,
weder mit dem alten Makro noch mit dem modifizierten.

Mit Gruß
Werner
Dateianhänge
Hauptordner.7z
(268 Bytes) 13-mal heruntergeladen

musikai
Beiträge: 158
Registriert: Do 14. Mai 2015, 17:53

Re: Wie vermeide ich den Ueberlauffehler?

Beitrag von musikai » So 14. Jan 2018, 18:19

Haha, das Wort "Ergebnix" mußt ich mir merken. :D

Aber Du hast tatsächlich recht. Bei mir zeigte es die 2 Ordner an und deren Inhalt, aber die einzelne Datei fehlte.
Lag natürlich an der Zählweise, die bei 1 anfängt, aber das Liste()-Array ja mit 0 startet. Gleichzeitig muss man in der Funktion am Ende zu z eins dazuzählen.
Hoffe, das stimmt jetzt so. Teste mal.

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() as string
Dim Desktop as object
Dim Mappe as object
Dim Tabelle as object
Dim oColumn As Object
Dim oFolderPicker as object
Dim sName As String
Dim sPath as String
Dim DateiNameVoll as String
Dim DateiName as String
Dim Dateityp as String
Dim DateiPfad as String
Dim i as long
dim z as long
Dim j as Integer
Dim n as Integer
Dim Zahl as long
Dim dummy()
Dim SortProps(2) As new com.sun.star.beans.PropertyValue
Dim SortFeld(1) As new com.sun.star.table.TableSortField
If (Not GlobalScope.BasicLibraries.isLibraryLoaded("Tools")) Then GlobalScope.BasicLibraries.LoadLibrary("Tools")
oFolderPicker = createUnoService("com.sun.star.ui.dialogs.FolderPicker")
oFolderPicker.execute
sPath = ConvertFromUrl(oFolderPicker.directory) 'das Hauptverzeichnis
if len(sPath)=0 then
exit sub
elseif len(sPath)>3 then
sPath=sPath & getpathseparator
end if
rem msgbox countmainfolders(sPath)
rem exit sub
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"

	  on error goto errorhandler1 
      rem----screenupdating turned off 
      ThisComponent.LockControllers
i = 1

Do While i<erg

   sName=ConvertFromURL(liste(i-1))
   DateiNameVoll=FileNameoutofPath(sName,getpathseparator())
   DateiName=GetFileNameWithoutExtension(DateiNameVoll)
   Dateityp=GetFileNameExtension(sName)
   DateiPfad=DirectoryNameoutofPath(sName,getpathseparator())
   
   
   Tabelle.getCellbyPosition(1,i).formulaLocal = "=HYPERLINK("+chr(34)+DateiPfad+getpathseparator()+chr(34)+")"
   
   Tabelle.getCellbyPosition(3,i).string = Dateityp 'Dateitype
   
   Tabelle.getCellbyPosition(2,i).string = DateiName
 
   Tabelle.getCellbyPosition(4,i).formulaLocal = "=HYPERLINK("+chr(34)+sName+chr(34)+")"
   
   i = i + 1
   Zahl = i
Loop

      rem----screenupdating turned on 
      ThisComponent.UnLockControllers
	  on error goto errorhandler2       
    
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"
exit sub
errorhandler1:
rem----screenupdating turned on 
ThisComponent.UnLockControllers
msgbox error
exit sub
errorhandler2:
msgbox error
End Sub

function getdirs( liste(),z, folder) 
	on error goto skip
   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
      	redim preserve liste(z)
        liste(z)=sFile
        z=z+1
     end if  
   next i    
skip:
   getdirs=z+1
end function
Win7 Pro, Sibelius 7.1.3, Lubuntu 15.10, LibO 4.4.7, OO 4.1.3
Free Project: LibreOffice Songbook Architect (LOSA)
http://struckkai.blogspot.de/2015/04/li ... itect.html



Antworten

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast