Hyperlinks aus mehreren ODTs auslesen und prüfen

[christophkirk]

Hi Zusammen, zugegeben, ich bin in OpenOffice noch ein Anfänger, habe allerdings viel In Excel VBA gemacht.
Nun habe ich das Problem, dass ich viele viele ODTs (Textdateien) habe, in denen Hyperlinks (auf interne andere Dokumente) oft veraltet sind. Meine Idee:
In einer Tabelle zum Dateinamen alle Hyperlinks der Datei auslesen und diese mittels FILEEXIST prüfen

ABER
(1) wie kann ich aus den ODTs die Hyperlinks herausfinden und
(2) was ist, wenn es ein Link aufs INTRANET ist. Kann ich den auch prüfen)

Bitte antwortet mir in einfacher Sprache ... Bin in VB sehr fit, bei Euch hier noch gar nicht
Aber FileExist habe ich durch Euer Forum schon in einer Tabelle zum laufen gekriegt.

Vielen DANK und VLG

[F3K Total]

Moin,
ich habe da mal ein Makro geschrieben:

Code: Alles auswählen

Sub show_Hyperlinks
    oText = ThisComponent.Text
    otextcursor = otext.createtextcursor
    oTextEmumeration = oText.CreateEnumeration
    while oTextEmumeration.hasmoreElements
        oparagraph = oTextEmumeration.nextElement
        opEnum = oparagraph.createEnumeration
        while opEnum.hasmoreElements
        oTextportion = opEnum.nextelement
        if oTextportion.HyperlinkURL <>"" then
            sHyperLinkText =  oTextportion.String       
            sHyperLinkName =  oTextportion.HyperLinkName
            sHyperLinkTarget =  oTextportion.HyperLinkTarget
            sHyperLinkURL  =  oTextportion.HyperlinkURL' Hier steht der URL des Links
            msgbox ("ANGEZEIGTER TEXT___: " & sHyperLinkText & chr(13) & chr(13)_
                 & +"NAME________________: " & sHyperLinkName & chr(13) & chr(13)_
                 & +"TARGET_______________: " & sHyperLinkTarget & chr(13) & chr(13)_
                 & +"URL___________________: " & sHyperLinkURL _
                    ,64,"Hier die Daten zum Hyperlink")
        endif
        wend
    wend
End Sub

Beispieldatei anbei.
Gruß R

[christophkirk]

Lieber F3K Total,

ich habe Dir noch gar nicht gedankt. Verzeihung!!! Es ist schon eine Zeit her, aber Deine Antwort hat mir schon geholfen. Eine Kleinigkeit bereitet mir noch Probleme, aber da melde ich mich evtl. nochmals.

VLG und nochmals DANKE SCHÖN !!!

[christophkirk]

Im folgenden habe ich die Datei etwas umgeschrieben, so dass sie die Hyperlinks aus einer anderen ODT Datei, also nicht aus der eigenen SCANT und ausgibt.

Was ich nun machen will, noch folgendes:
- Ordner auswählen lassen
- Alle ODTs in diesem Ordner nach und nach durchgehen
- ODT-Dateinamen in Spalte 1 schreiben
- Alle Hyperlinks untereinander in Spalte 2 schreiben
- Datei schließen
- Nächste Datei öffne usw.

Code: Alles auswählen

REM  *****  BASIC  *****

Sub show_Hyperlinks

    url=converttourl("d:\test1.odt")
    dim myFileProp(0) as New com.sun.star.beans.PropertyValue
    dim i as integer
    myFileProp(0).name="Hidden"
    myFileProp(0).value=True
    oDocument = StarDesktop.loadComponentFromURL(url, "_blank", 0, myFileProp() )

    oText = oDocument.Text
    otextcursor = otext.createtextcursor
    oTextEmumeration = oText.CreateEnumeration
    while oTextEmumeration.hasmoreElements
        oparagraph = oTextEmumeration.nextElement
        opEnum = oparagraph.createEnumeration
        while opEnum.hasmoreElements
        oTextportion = opEnum.nextelement
        if oTextportion.HyperlinkURL <>"" then
            sHyperLinkText =  oTextportion.String       
            sHyperLinkName =  oTextportion.HyperLinkName
            sHyperLinkTarget =  oTextportion.HyperLinkTarget
            sHyperLinkURL  =  oTextportion.HyperlinkURL' Hier steht der URL des Links
            msgbox ("ANGEZEIGTER TEXT___: " & sHyperLinkText & chr(13) & chr(13)_
                 & +"NAME________________: " & sHyperLinkName & chr(13) & chr(13)_
                 & +"TARGET_______________: " & sHyperLinkTarget & chr(13) & chr(13)_
                 & +"URL___________________: " & sHyperLinkURL _
                    ,64,"Hier die Daten zum Hyperlink")
        endif
        wend
    wend
    
    oDocument.close(true)
    
End Sub

Kann mir jemand einen Tipp geben, wie ich am besten nach CODE suchen kann? Bei Excel VBA habe ich z.B. HERBER-EXCEL Forum lieben gelernt. Sucht Ihr nur hier? Und wenn ja, wie am besten? DANKE EUCH

[F3K Total]

Moin,
obwohl ich stinkig bin, weil du dich grundlos ein Jahr lang nicht gemeldet hast, fand ich das Thema interessant und habe eine Lösung gebaut. Anbei ein Ordner HYPERLINKS_AUSLESEN.zip.

• Entpacke den Ordner
• Öffne die Calc-Datei Check_Hyperlinks.ods
• klicke auf die Schaltfläche Hyperlinks prüfen
• navigiere zum Ordener in dem die zu prüfenden .odt Dateien liegen, ich habe mal drei in den Ordner QUELLDOKUMENTE gelegt,
• klicke OK.

Ergebnis in der Calc-Datei:

HLA.png (39.19 KiB) 369 mal betrachtet

Folgender Code erledigt das für dich:

Code: Alles auswählen

Sub pick_Folder_Import_Writer_Files
Dim Args(0) As New com.sun.star.beans.PropertyValue
Args(0).Name = "Hidden"
Args(0).Value = True
Dim nURL as String
    MyDialog = createunoservice("com.sun.star.ui.dialogs.FolderPicker")
    if mydialog.execute= 0 then
        exit sub
    endif
    nCounter = 1
    sURL = mydialog.directory & "/"
    NextFile = Dir(sURL, 0)
    if right(NextFile,4) = ".odt" then
    oWriterDocument = StarDesktop.loadComponentFromURL(sURL & NextFile, "_blank", 0, Args())
    extract_Hyperlinks(oWriterDocument)
    oWriterDocument.close -1
    endif
    While NextFile  <> ""
        on error goto EXITER
        NextFile  = Dir
        if right(NextFile,4) = ".odt" then
            oWriterDocument = StarDesktop.loadComponentFromURL(sURL & NextFile, "_blank", 0, Args())
            extract_Hyperlinks(oWriterDocument)
            oWriterDocument.close -1
        endif
    Wend
    EXITER:
end sub

Sub extract_Hyperlinks(oWriterDocument)
    oSheet = ThisComponent.Sheets.getbyname("Check_Hyperlinks")
    oCursor = oSheet.CreateCursor
    oCursor.gotoendofusedArea(false)
    nRow = oCursor.Rangeaddress.Endrow + 1
    oText = oWriterDocument.Text
    otextcursor = otext.createtextcursor
    oTextEmumeration = oText.CreateEnumeration
    while oTextEmumeration.hasmoreElements
        oparagraph = oTextEmumeration.nextElement
        opEnum = oparagraph.createEnumeration
        while opEnum.hasmoreElements
        oTextportion = opEnum.nextelement
        if oTextportion.HyperlinkURL <>"" then
            sFileURL = oWriterDocument.URL
            sHyperLinkText =  oTextportion.String       
            sHyperLinkName =  oTextportion.HyperLinkName
            sHyperLinkTarget =  oTextportion.HyperLinkTarget
            sHyperLinkURL  =  oTextportion.HyperlinkURL' Hier steht der URL des Links
            oCellFileURL = oSheet.getCellbyposition(0,nRow)            
            oCellHyperLinkText = oSheet.getCellbyposition(1,nRow)
            oCellHyperLinkName = oSheet.getCellbyposition(2,nRow)
            oCellHyperLinkTarget = oSheet.getCellbyposition(3,nRow)
            oCellHyperLinkURL = oSheet.getCellbyposition(4,nRow)
            oCellHyperLinkOK = oSheet.getCellbyposition(5,nRow)
            oCellFileURL.String = sFileURL
            oCellHyperLinkText.String = osHyperLinkText
            oCellHyperLinkName.String = sHyperLinkName
            oCellHyperLinkTarget.String = sHyperLinkTarget
            oCellHyperLinkURL.String = sHyperLinkURL
            if fileexists(sHyperLinkURL) Then
                oCellHyperLinkOK.String = "OK"
            else
                oCellHyperLinkOK.String = "nicht OK"
            Endif
            nROw = nRow + 1
        endif
        wend
    wend
End Sub

Gruß R

[christophkirk]

1000 DANK !!! Du bist spitze. Ich habe auch einige Versuche unternommen, aber meine haben immer wieder Probleme bereitet...

Und nochmals SORRY... Mein Jahr "Auszeit" war nicht gegen Dich gerichtet. Wollte sicherlich KEINEN damit kränken oder unhöflich sein

[christophkirk]

Dein CODE klappt PERFEKT, wirklich soooo COOL...

Ich habe noch eine Frage bzw. einen Wunsch:

Wäre es möglich, dass er nach dem Durchstöbern des Ordners auch Unterordner erkennt und diese ebenfalls checkt? Evtl. nach einer Abfrage, ob Unterordner AUCH gescannt werden sollen?

Habe im Forum schon verstanden, dass man Unterordner auslesen kann, aber ich verhaue mich da immer mit den Doppelschleifen. UND die Unterordner hiervon werden nicht mitgelesen. In meinem VBA Code war das einfach, weil die Funktion auch Unter- Unter-Unterordner durchstöbert, wenn ich das wollte...

DANKE VIELMALS !!!!!

[christophkirk]

Hallo Zusammen,

leider habe ich unter einer anderen Umgebung folgendes Problem:

BASIC-Laufzeitfehler.
Eigenschaft oder Methode nicht gefunden: createEnumeration

Umgebung ist...
CIB Office
Version: 6.4.0.13 (x64)
Build-ID: ce14db425434c10551a0ff794cba2ccc049d4f70
CPU-Threads: 4; BS: Windows 10.0 Build 17763; UI-Render: Standard; VCL: win;
Gebietsschema: de-DE (de_DE); UI-Sprache: de-DE
Calc: threaded

Hat jemand einen Tipp? Irgendetwas scheint nicht geladen zu sein. Hier sind meine Möglichkeite an diesem System aber sehr begrenzt. NAchladen von Addins etc. ist leider nicht möglich.

Kann ich da per "echtem" CODE was ergänzen?

VLG UND DANKE

[F3K Total]

Hallo christophkirk,
was bitte ist CIB Office?
Habe es gerade mit LO 7.4.5 u nd 7.3.7 probiert, null problemo.
Was die Frage nach den Unterordnern anbelangt, dass ist nur deine eigene Faulheit,
kannst du gerne selbst programmieren, ist ja nur Copy/Paste ... sonst klickste halt ein bisschen öfter.

Gruß R