Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
704to708
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
704to708
704to708
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Favoriten auslesen

Favoriten auslesen
03.12.2005 20:37:32
Rolf
Hallo Forum,
der folgende Code von Nepumuk schreibt unter Windows - u. Office 2000
in Spalte A den Hyperlink der jeweiligen Internetverknüpfungsdatei -
unter XP/Excel 2003 wird hingegen der Dateipfad ausgegeben.
Hat jemand eine Erklärung bzw. eine Lösung für XP?
hG
Rolf
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" ( _
ByVal hwndOwner As Long, _
ByVal nFolder As Long, _
ByRef pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" ( _
ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Type ITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ITEMID
End Type
Private Const R_FAVORITS = &H6
Private Const NOERROR = 0&
Private Const GCCLASSNAMEMSEXCEL = "XLMAIN"
Private myFileSystemObject As Object, myFolder As Object
Public Sub Read_Favorits()
Dim lngRow As Long
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
Call FindFiles(GetPath(R_FAVORITS), lngRow)
Set myFileSystemObject = Nothing
End Sub

Private Sub FindFiles(ByVal strPath As String, ByRef lngRow As Long)
Call GetFilesInFolder(strPath, lngRow)
For Each myFolder In myFileSystemObject.GetFolder(strPath).SubFolders
Call FindFiles(myFolder.Path & "\", lngRow)
Next
End Sub


Private Sub GetFilesInFolder(ByVal strPath As String, ByRef lngRow As Long)
Dim myfile As File
For Each myfile In myFileSystemObject.GetFolder(strPath).Files
If LCase$(Right$(myfile.Name, 4)) = ".url" Then
With Application.FileSearch
.LookIn = strPath
.Filename = Left$(myfile.Name, Len(myfile.Name) - 4)
.FileType = msoFileTypeAllFiles
If .Execute = 1 Then
lngRow = lngRow + 1
Cells(lngRow, 1).Value = .FoundFiles(1)
Cells(lngRow, 2).Value = Left$(myfile.Name, Len(myfile.Name) - 4)
End If
End With
End If
Next
End Sub


Private Function GetPath(lNumber As Long) As String
Dim lResult As Long, lBuffer As String
Dim Idl As ITEMIDLIST
lResult = SHGetSpecialFolderLocation(FindWindow(GCCLASSNAMEMSEXCEL, _
Application.Caption), lNumber, Idl)
If lResult = NOERROR Then
lBuffer = Space$(512)
lResult = SHGetPathFromIDList(ByVal Idl.mkid.cb, ByVal lBuffer)
If lResult Then _
GetPath = Left$(lBuffer, Len(Trim$(lBuffer)) - 1) & "\"
End If
End Function

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
XP-Problem b.a.w. gelöst
04.12.2005 13:41:06
Rolf
Hallo Forum,
die mögliche XP-Lösung siehe
http://www.online-excel.de/fom/fo_read.php?f=1&h=6348&bzh=6379#a123x
An einer Lösung, die direkt auf die Dateieigenschaften von
Internetverbindungsdateien zugreift, bin ich aber nach wie vor interessiert.
Freundliche Grüße
Rolf
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige