letzify
Feb 08, 2015, updated at Feb 09, 2015 (UTC)
view1773
view10
0
Goto Top

Defekten Verzeichnis- bzw. Dateilink via Makro (Excel) markieren

GermansolvedQuestionVB for ApplicationsDevelopment
Hallo da draußen,

ich habe eine Frage zu einem Makro, welches mich jetzt schon fast wahnsinnig macht. Ich suche ein Makro, welches mir defekte Links aus einer Tabelle raussucht und mir meinetwegen einfach nur rot markiert.

Das Problem:
Ich habe einige Makros gefunden, die alle ganz super sind. Nur leider markieren sie mir ALLE Links, auch jene, die funktionieren (bei Verzeichnissen).

Kurioserweise markiert er mir Dateien korrekt, also sowohl wenn sie funktionieren (keine Markierung) als auch wenn sie defekt sind (Markierung).

Ein Makro:
Option Explicit

Sub HyperlinksTesten()
Dim HyperL As Hyperlink, Zelle As Range, Addresse As String

For Each HyperL In ActiveSheet.Hyperlinks
If Not HyperL.Address Like "*\*" Then  
Addresse = ActiveWorkbook.Path & "\" & HyperL.Address  
Else
Addresse = HyperL.Address
End If
If Dir(Addresse) = "" Then  
Set Zelle = HyperL.Range
HyperL.Delete
Zelle = "ERROR: " & Addresse  
Zelle.Font.ColorIndex = 3
End If
Next
End Sub

Kann mir jemand helfen? Bitte...
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 262796

Url: https://administrator.de/contentid/262796

Printed on: April 23, 2024 at 21:04 o'clock

10 Comments
Latest comment
Goto Top
Member: Letzify
Letzify Feb 09, 2015 at 06:35:27 (UTC)
Goto Top
Hat niemand eine Idee? Ich hatte vermutet, dass diese Zeile hier noch angepasst werden müsste, habe aber keine Idee um was.

If Dir(Addresse) = "" Then

Ich habe in einem anderen Makro einen anderen Dir-Befehl gesehen, der wohl auch Verzeichnisse prüft, aber der funktioniert in diesem Makro nicht.
Mitglied: 114757
Solution 114757 Feb 09, 2015, updated at Jun 15, 2015 at 13:43:32 (UTC)
Goto Top
Schon wieder so eine ungeduldige Natur ....
Option Explicit
Option Compare Text

Sub HyperlinksTesten()
    Dim HyperL As Hyperlink, Addresse As String, rng As Range, fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")  

    For Each HyperL In ActiveSheet.Hyperlinks
        If Not HyperL.Address Like "*\*" Then  
            Addresse = ActiveWorkbook.Path & "\" & HyperL.Address  
        Else
            Addresse = HyperL.Address
        End If
        If not fso.FolderExists(Addresse) and Not fso.FileExists(Addresse) Then
            With HyperL
                Set rng = HyperL.Range
                .Range.Value = "ERROR: " & Addresse  
                .Delete
                rng.Font.ColorIndex = 3
            End With
        End If
    Next
    set fso = Nothing
End Sub
Gruß jodel32
Mitglied: 116301
116301 Feb 09, 2015 at 09:06:54 (UTC)
Goto Top
Hallo Jodel32!

Mhm..., Löschen wenn der Pfad existiert?


Grüße Dieter
Mitglied: 114757
114757 Feb 09, 2015 updated at 09:23:11 (UTC)
Goto Top
Zitat von @116301:
Mhm..., Löschen wenn der Pfad existiert?
Ohhh my god, sorry ist korrigiert face-wink. Danke dir.
Mitglied: 116301
116301 Feb 09, 2015 updated at 09:59:14 (UTC)
Goto Top
Hallo Jodel!

Ohhh my god, sorry ist korrigiert...
OK, aber dann bitte mit einem 'And'face-smile

Grüße Dieter
Member: Biber
Biber Feb 09, 2015 updated at 10:17:03 (UTC)
Goto Top
Moin jodel32,

ich bin ja eigentlich kein Fan von globalen Variablen.

Aber in einer Schleife über x Elemente jedesmal in IsFolder()/IsFile() in dieser Prüfung
If Not IsFolder(Addresse) and Not IsFile(Addresse) then
.. ein neues FileSystemObject erzeugen... ja nee.

Zu meiner Zeit haben wir nicht zu rumgeaast mit den Ressourcen.
Allerdings hatte damals ein handelsübliches Rechenzentrum nur die Power von anderthalb Einsteiger-Smartphones.

Ich würde trotzdem einmalig ein Object oFso=CreateObject("Scripting.FileSystemObject") erzeugen, rein aus Gewohnheit, und dieses in den beiden Functions vewenden.

Oder noch wahrscheinlicher, ich würde hier auf Kapselkrams verzichten.

....
oFSO= CreateObject("Scripting.FileSystemObject")  

...  If Not oFSO.FolderExists(Addresse) and Not oFSO.FileExists(Addresse) then 
...

Grüße
Biber
Member: Letzify
Letzify Feb 09, 2015 updated at 10:26:59 (UTC)
Goto Top
Guten Morgen,

vielen Dank, ich teste die Lösung sofort. Wollte nicht ungeduldig sein, aber der Chef will Ergebnisse :D

In Zeile 14 verlangt er von mir ein Objekt? Das Makro funktioniert so also leider nicht...
Mitglied: 114757
114757 Feb 09, 2015 updated at 10:50:31 (UTC)
Goto Top
So damit nun hoffentlich alle zufrieden sind, oben angepasst ...

aber der Chef will Ergebnisse :D
Fremde federn ... falscher Job !?
Member: Letzify
Letzify Feb 09, 2015 at 12:43:03 (UTC)
Goto Top
Danke Jodel, hat scheinbar geklappt.
Member: Joarden
Joarden Jun 15, 2015 at 13:33:18 (UTC)
Goto Top
Hallo Zusammen,

ich habe das gleiche Problem wie Letzify. Ich möchte Hyperlinks auf Funktionsfähigkeit testen und bei false rot markieren.
Leider funktioniert das mit dem Makro, welches ich von Jodel32´s Beitrag kopiert habe nicht ganz.
Mit VBA habe ich mich erst seit drei Tagen, aufgrund dieses Problems, beschäftigt. Daher habe ich nicht wirklich viel Hintergrundwissen.

Hier ein Bild von meiner Tabelle (die ist natürlich viel größer, dient nur als Beispiel) und dem Entwicklerfenster daneben.
Was muss ich anpassen, damit es funktioniert?

Bild: http://abload.de/img/hyperlink6euym.jpg

Über Hilfe würde ich mich sehr freuen!
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments