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