Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1720to1724
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

Dateiliste

Dateiliste
01.11.2019 10:59:14
Herbert
Hallo,
mit dem nachstehenden Code erhalte ich eine Dateiliste vom Desktop, mit dem Datei-Datum.
Sub DateilisteMitVerknüpfungsziel()
Dim strFileName$, strFolder$, lngRow&, objArr As Object, vArr(1 To 1, 1 To 2)
strFolder = "C:\Users\...\Desktop\"
Set objArr = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Columns(1).Clear
Columns(2).Clear
strFileName = Dir$(strFolder)
Do Until strFileName = vbNullString
lngRow = lngRow + 1
vArr(1, 1) = strFileName
vArr(1, 2) = FileDateTime(strFolder & strFileName)
objArr(lngRow) = vArr
strFileName = Dir$
Loop
ActiveSheet.Cells(1, 1).Resize(objArr.Count, UBound(vArr, 2)) = _
Application.Transpose(Application.Transpose(objArr.items))
Application.ScreenUpdating = True
Set objArr = Nothing
End Sub
´
So weit so gut. Doch nun möchte ich, anstatt des Datums, das Verknüpfungsziel ausgeben. Doch finde ich leider nix dazu im INet. Habt ihr evtl. eine Lösung?
Vielen Dank im Voraus.
Servus

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: teste mal
01.11.2019 11:06:22
Fennek
Hallo,
aus dem Archiv (vermutlich von snb)

Option Explicit
Public Sub Verknuepfungen_auslesen()
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Dim objLink As Object
Set objShell = CreateObject(Class:="Shell.Application")
Set objFolder = objShell.Namespace("C:\Dokumente und Einstellungen\HP\Desktop\")
For Each objFile In objFolder.Items
If objFile.IsLink Then
Set objLink = objFile.GetLink
With objLink
Call MsgBox(.Path & vbLf & .Target.Path & vbLf & .Description)
End With
End If
Next
Set objLink = Nothing
Set objFolder = Nothing
Set objShell = Nothing
End Sub
mfg
Anzeige
AW: teste mal
01.11.2019 11:15:35
Herbert
Hallo Fenek,
das ist es leider nicht, da ich für ALLE Verknüpfungen auf dem Desktop die Namen und das Verknüpfungsziel benötige. Danke.
Vielleicht gibt es ja noch eine Lösung.
Servus
AW: Dateiliste
01.11.2019 14:14:56
EtoPHG
Ciao Herbert,
so:
Sub DateilisteMitVerknüpfungsziel()
Dim strFileName$, strFolder$, lngRow&, objArr As Object, vArr(1 To 1, 1 To 2)
strFolder = Environ("userprofile") & "\Desktop\"
Set objArr = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Columns(1).Clear
Columns(2).Clear
strFileName = Dir$(strFolder)
Do Until strFileName = vbNullString
lngRow = lngRow + 1
If Right(strFileName, 3) = "lnk" Then
vArr(1, 1) = Getlnkpath(strFolder & strFileName)
Else
vArr(1, 1) = strFileName
End If
vArr(1, 2) = FileDateTime(strFolder & strFileName)
objArr(lngRow) = vArr
strFileName = Dir$
Loop
ActiveSheet.Cells(1, 1).Resize(objArr.Count, UBound(vArr, 2)) = _
Application.Transpose(Application.Transpose(objArr.items))
Application.ScreenUpdating = True
Set objArr = Nothing
End Sub
Function Getlnkpath(ByVal Lnk As String)
On Error Resume Next
With CreateObject("Wscript.Shell").CreateShortcut(Lnk)
Getlnkpath = .TargetPath
.Close
End With
End Function
Gruess Hansueli
Anzeige
AW: Dateiliste
01.11.2019 16:41:23
Herbert
Servus Hansueli,
vielen Dank, Das funktioniert schon mal. Allerdings bringt er mir den Namen der Verknüpfung nicht. Das Datum brauche ich dagegen nicht unbedingt. Wie kriege ich in Spalte A den Namen und in Spalte B das Ziel bitte?
Servus
AW: Dateiliste
01.11.2019 17:01:19
Herbert
Hallo Hansueli,
alles gut und vielen Dank. Ich habs nun selbst hingebracht, dass er mir sowohl den Namen als auch das Ziel anzeigt. Aber nur, dank Deiner Hilfe! Nochals viielen Dank!
Sers
AW: Dateiliste
01.11.2019 17:13:52
Herbert
Hallo Hansueli,
jetzt habe ich festgestellt, dass er mir nicht alle Desktop-Verknüpfungen auflistet. Z. B. fehlt Acronis True Image oder auch iTunes. Woran kann das liegen?
"If Right(strFileName, 3) = "lnk" Then" das habe ich übrigens entfernt, da ich dachte, dass er dann alles was auf dem Desktop liegt anzeigt.
Servus
Anzeige
Selber basteln, aber nix verstehn? ;-)
01.11.2019 17:48:03
EtoPHG
Herbert
Es gibt Leute, die haben nicht nur Links (LNK) auf ihrem Desktop, darum der IF Right...
...und wie Hajo immer so schön sagt: "Ich schaue nicht auf fremde Recher" ;-)
Wenn nichts angezeigt wird, für das Ziel, kann das z.B. Beispiel daran liegen, dass Adminrechte für die Zielermittlung nötig sind. Aber das ist nur ein möglicher Grund. Die Verlinkung in Windows, ist ein ziemlich tricky business. Wenn du auf einer .lnk-Datei die Eigenschaften anzeigst zu dort nichts im Ziel steht, habe ich im Moment keinen Plan, wie ich das per VBA ermitteln könnte.
Und noch was: Wer um Himmelswillen arbeitet mit iTunes?
Gruess Hansueli
Anzeige
AW: Selber basteln, aber nix verstehn? ;-)
01.11.2019 17:57:25
Herbert
Hallo Hansueli,
;o)=) iTunes! Du hast recht, das ist noch ein Überbleibsel aus grauer Vorzeit. Das kann ja nun weg. Aber warum er mir Acronis True Image nicht anzeigt, weiß ich auch nicht. Er zeigt es übrigens auch im Desktop-Ordner nicht an. Dann hat es wahrscheinlich etwas mit Admin-Rechten etc. zu tun. Aber damit kann ich leben.
Übrigens muss ich das Ganze deshalb machen, da ich gerade dabei bin, auf meinem neuen PC Win10 in Betrieb zu nehmen, da MS ja den Support für Win7 demnächst einstellt, und versuche, so viel als möglich vom alten PC zu übernehmen.
Ich danke Dir für Deine Tipps!
Servus
Anzeige
Linkliste
02.11.2019 13:25:51
Anton
auch hallo ,
Aber warum er mir Acronis True Image nicht anzeigt, weiß ich auch nicht.
ich kann mir vorstellen , dass Link dazu auf dem AllUsersDesktop liegt, deswegen so?:
Code in Zwischenablage:

Sub b()
  Dim WshShell As Object, fso As Object  
  Dim oFolder As Variant, oFile As Object    
  Set fso = CreateObject("Scripting.FileSystemObject")  
  Set WshShell = CreateObject("WScript.Shell")  
  For Each oFolder In WshShell.SpecialFolders  
    If InStr(1, LCase(oFolder), "desktop") <> 0 Then    
      For Each oFile In fso.getfolder(oFolder).Files  
        If LCase(fso.GetExtensionName(oFile)) = "lnk" Then    
          Debug.Print "Link: " & oFile & vbTab & " zu: " & _
          WshShell.CreateShortcut(oFile).TargetPath
        End If  
      Next
    End If  
  Next
End Sub  

mfg Anton
Anzeige
AW: Linkliste
02.11.2019 16:35:36
Herbert
Hallo Anton,
vielen Dank für Deinen Vorschlag, der super funktioniert! Aber warum bringt er mir fast alle Links doppelt?
Servus

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige