Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1216to1220
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verknüpfungen auflisten

Verknüpfungen auflisten
Franz
Guten Morgen Fachleute,
ich hab ein Makro, das Dateien eines bestimmten Dateityps auflistet:
Einlesen des gesuchten Dateityps aus einer Zelle:
strFileType = Worksheets("Tabelle1").Range("Dateityp")
Suchen:
With Application.FileSearch
.NewSearch
.Filename = strFileType
.LookIn = strVz
.Execute
Nun möchte ich aber alle in einem Ordner liegenden Verknüpfungen auflisten. Allerdings findet obiger Code nur Dateien, er findet keine Verknüpfungen. Gibt es eine Möglichkeit, auch nach Verknüpfungen zu suchen?
Danke schonmal im Voraus und Grüße
Franz W.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Verknüpfungen auflisten
01.06.2011 13:52:32
Tino
Hallo,
vielleicht so.
Option Explicit
 
Sub Find_Verknuepfung()
Dim FSO As Object, Ordner As Object, F1 As Object
Dim n&, ArrayV()
Dim SucheDatei$

SucheDatei = "lnk" 'Dateiendung? 

Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo ErrorHandler:
'hier Pfad angeben 
Set Ordner = FSO.getfolder("C:\Ordner")

If Ordner.Files.Count > 0 Then
    Redim Preserve ArrayV(1 To Ordner.Files.Count)
    'Schleife über alle Dateien im Ordner 
    For Each F1 In Ordner.Files
      If LCase(FSO.GetExtensionName(F1)) = SucheDatei Then
        n = n + 1
        ArrayV(n) = F1.Name
      End If
    Next F1
    
    With Sheets("Tabelle1") 'Tabelle anpassen 
        'Bereich leer machen für neue Daten 
        .Range("A2", .Cells(.Rows.Count, 1)).ClearContents
        If n > 0 Then
            Redim Preserve ArrayV(1 To n)
            'Daten einfügen 
            .Range("A2").Resize(n) = Application.Transpose(ArrayV)
        End If
    End With
End If

ErrorHandler:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical + vbMsgBoxHelpButton, _
          "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Gruß Tino
Anzeige
toll! Fürs erste.....
01.06.2011 14:59:36
Franz
Hallo Tino,
ja, wunderbar, ist ne tolle Lösung, die funktioniert auch. Im Gegensatz zu "FileSearch", die "*.lnk" nicht kennt und ne Fehlermeldung bringt von wegen .....nicht gefunden.....
Ne kleine Zusatzfrage hätt ich noch: Gibt es jetzt noch die Möglichkeit, auch nach *.*, also nach allen Dateien im Orner zu suchen? Verknüpfungen und beliebigen anderen Dateien?
Danke schonmal und Grüße
Franz
müsste so gehen...
01.06.2011 15:56:57
Tino
Hallo,
für den Suchbegriff kannst Du Platzhalter verwenden, siehe auch in der Hilfe unter Like (Operator).
Sub Find_Verknuepfung()
Dim FSO As Object, Ordner As Object, F1 As Object
Dim n&, ArrayV()
Dim SucheDatei$

SucheDatei = "*.*" 'Dateiendung? 

Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo ErrorHandler:
'hier Pfad angeben 
Set Ordner = FSO.getfolder("C:\Ordner")

If Ordner.Files.Count > 0 Then
    SucheDatei = LCase(SucheDatei)
    Redim Preserve ArrayV(1 To Ordner.Files.Count)
    'Schleife über alle Dateien im Ordner 
    For Each F1 In Ordner.Files
      If LCase(F1.Name) Like SucheDatei Then
        n = n + 1
        ArrayV(n) = F1.Name
      End If
    Next F1
    
    With Sheets("Tabelle1") 'Tabelle anpassen 
        'Bereich leer machen für neue Daten 
        .Range("A2", .Cells(.Rows.Count, 1)).ClearContents
        If n > 0 Then
            Redim Preserve ArrayV(1 To n)
            'Daten einfügen 
            .Range("A2").Resize(n) = Application.Transpose(ArrayV)
        End If
    End With
End If

ErrorHandler:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical + vbMsgBoxHelpButton, _
          "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Gruß Tino
Anzeige
nein, leider nicht
01.06.2011 16:28:58
Franz
Hallo Tino,
nein, "*.*" geht leider nicht, das hab ich auch schon probiert, da bleibt n = 0, es wird nichts gelistet. Auch "*.lnk" geht nicht. Es klappt nur mit "lnk"
Grüße
Franz
AW: nein, leider nicht
01.06.2011 16:49:28
Tino
Hallo,
hast du auch den Code verwendet?
Gruß Tino
sorry
01.06.2011 16:55:58
Franz
oh, sorry, nein, die Zeile mit "Like SucheDatei Then" hab ich übersehen. So geht's natürlich! Hast mir toll geholfen, vielen Dank und
beste Grüße
Franz W
If Datei.IsLink Then With Datei.GetLink
01.06.2011 17:35:31
ransi
HAllo
Alternativ zu Filesearch geht auch sowas:
Das Ding geht nur auf Verknüpfungen und Hyperlinks los.
Option Explicit




Public Sub Verknuepfungen_auslesen()
    Dim Sh As Object
    Dim ordner As Object
    Dim Datei As Object
    Set Sh = CreateObject("Shell.application")
    Set ordner = Sh.NameSpace("C:\Dokumente und Einstellungen\") 'anpassen
    For Each Datei In ordner.items
        If Datei.IsLink Then
            Debug.Print Datei.Path & vbCrLf _
                & Datei.Type
            With Datei.GetLink
                Debug.Print _
                    .Path & vbCrLf & _
                    .Target.Path & vbCrLf & _
                    .Description & vbCrLf
            End With
        End If
    Next
End Sub


ransi
Anzeige
AW: If Datei.IsLink Then With Datei.GetLink
02.06.2011 01:11:42
Franz
Hallo Ransi,
vielen Dank, ist kurz und knapp, werd ich morgen anpassen und ausprobieren (jetzt sind meine Lider zu schwer)....
Danke und Grüße
Franz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige