Verknüpfungen auflisten

Forumthread: 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.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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

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

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

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)

Forumthread: Verknüpfungen auflisten

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread