je voudrais lister les favoris internet dans une feuille excel...
j'ai utilise une macro qui liste les fichiers d'un repertoire mais les
raccourcis internet n'apparaissent pas...
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Michel Pierron
Bonjour Albator V;
Sub FavoritesFolderSave() Dim FavoritesFolder As String FavoritesFolder = CreateObject("WScript.Shell") _ .SpecialFolders("Favorites") Application.ScreenUpdating = False Workbooks.Add Call FilesInFolder(FavoritesFolder, 0, True) End Sub Private Sub FilesInFolder(sFolderName As String _ , Optional Rw As Long = 0 _ , Optional SubDirs As Boolean = True) Dim FSO As Object, SourceFolder As Object Dim FileItem As Object, SubFolder As Object Dim FileType As String, n As String Set FSO = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FSO.GetFolder(sFolderName) Rw = Rw + 1 Cells(Rw, 1) = sFolderName Cells(Rw, 1).Font.Bold = True For Each FileItem In SourceFolder.Files Application.StatusBar = SourceFolder & FileItem.Name If InStr(1, FileItem.Type, "Internet", 1) Then Rw = Rw + 1 Cells(Rw, 2) = FileItem.Name Rw = Rw + 1 n = ReadFile(FileItem.Path) ActiveSheet.Hyperlinks.Add _ Cells(Rw, 3), n, , n, n End If Next FileItem If SubDirs Then For Each SubFolder In SourceFolder.SubFolders Rw = Rw + 1 Call FilesInFolder(SubFolder.Path, Rw, True) Next SubFolder End If Application.StatusBar = False Columns("A:B").ColumnWidth = 1 Set FileItem = Nothing Set SubFolder = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
Private Function ReadFile(FilePath) As String On Error Resume Next ReadFile = CreateObject("Wscript.Shell") _ .CreateShortcut(FilePath).TargetPath End Function
MP
"Albator V" a écrit dans le message de news:
Bonjour a tous,
je voudrais lister les favoris internet dans une feuille excel... j'ai utilise une macro qui liste les fichiers d'un repertoire mais les raccourcis internet n'apparaissent pas...
pouvez vous m'aider ?
Et peut t'on recuperer l'historique internet ?
Bonjour Albator V;
Sub FavoritesFolderSave()
Dim FavoritesFolder As String
FavoritesFolder = CreateObject("WScript.Shell") _
.SpecialFolders("Favorites")
Application.ScreenUpdating = False
Workbooks.Add
Call FilesInFolder(FavoritesFolder, 0, True)
End Sub
Private Sub FilesInFolder(sFolderName As String _
, Optional Rw As Long = 0 _
, Optional SubDirs As Boolean = True)
Dim FSO As Object, SourceFolder As Object
Dim FileItem As Object, SubFolder As Object
Dim FileType As String, n As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(sFolderName)
Rw = Rw + 1
Cells(Rw, 1) = sFolderName
Cells(Rw, 1).Font.Bold = True
For Each FileItem In SourceFolder.Files
Application.StatusBar = SourceFolder & FileItem.Name
If InStr(1, FileItem.Type, "Internet", 1) Then
Rw = Rw + 1
Cells(Rw, 2) = FileItem.Name
Rw = Rw + 1
n = ReadFile(FileItem.Path)
ActiveSheet.Hyperlinks.Add _
Cells(Rw, 3), n, , n, n
End If
Next FileItem
If SubDirs Then
For Each SubFolder In SourceFolder.SubFolders
Rw = Rw + 1
Call FilesInFolder(SubFolder.Path, Rw, True)
Next SubFolder
End If
Application.StatusBar = False
Columns("A:B").ColumnWidth = 1
Set FileItem = Nothing
Set SubFolder = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub
Private Function ReadFile(FilePath) As String
On Error Resume Next
ReadFile = CreateObject("Wscript.Shell") _
.CreateShortcut(FilePath).TargetPath
End Function
MP
"Albator V" <AlbatorV@discussions.microsoft.com> a écrit dans le message de
news: 25EB2F97-0B93-485B-86AA-BDE25DFE60B1@microsoft.com...
Bonjour a tous,
je voudrais lister les favoris internet dans une feuille excel...
j'ai utilise une macro qui liste les fichiers d'un repertoire mais les
raccourcis internet n'apparaissent pas...
Sub FavoritesFolderSave() Dim FavoritesFolder As String FavoritesFolder = CreateObject("WScript.Shell") _ .SpecialFolders("Favorites") Application.ScreenUpdating = False Workbooks.Add Call FilesInFolder(FavoritesFolder, 0, True) End Sub Private Sub FilesInFolder(sFolderName As String _ , Optional Rw As Long = 0 _ , Optional SubDirs As Boolean = True) Dim FSO As Object, SourceFolder As Object Dim FileItem As Object, SubFolder As Object Dim FileType As String, n As String Set FSO = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FSO.GetFolder(sFolderName) Rw = Rw + 1 Cells(Rw, 1) = sFolderName Cells(Rw, 1).Font.Bold = True For Each FileItem In SourceFolder.Files Application.StatusBar = SourceFolder & FileItem.Name If InStr(1, FileItem.Type, "Internet", 1) Then Rw = Rw + 1 Cells(Rw, 2) = FileItem.Name Rw = Rw + 1 n = ReadFile(FileItem.Path) ActiveSheet.Hyperlinks.Add _ Cells(Rw, 3), n, , n, n End If Next FileItem If SubDirs Then For Each SubFolder In SourceFolder.SubFolders Rw = Rw + 1 Call FilesInFolder(SubFolder.Path, Rw, True) Next SubFolder End If Application.StatusBar = False Columns("A:B").ColumnWidth = 1 Set FileItem = Nothing Set SubFolder = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
Private Function ReadFile(FilePath) As String On Error Resume Next ReadFile = CreateObject("Wscript.Shell") _ .CreateShortcut(FilePath).TargetPath End Function
MP
"Albator V" a écrit dans le message de news:
Bonjour a tous,
je voudrais lister les favoris internet dans une feuille excel... j'ai utilise une macro qui liste les fichiers d'un repertoire mais les raccourcis internet n'apparaissent pas...
Bonjour Albator V; Pour l'historique, c'est une autre paire de manche; l'historique est conservé dans les fichiers index.dat des differents dossiers cache d'internet explorer. Les fichiers index.dat sont normalement invisibles à l'utilisateur même avec toutes les options d'affichage cochées dans les options de dossier. Tu peux lister le contenu de l'historique en utilisant:
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _ (ByVal hwnd As Long, ByVal nFolder As Long, Pidl As Long) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" _ (Pidl As Long, ByVal FolderPath As String) As Long
Private Function FindSysFolder(ByVal lNum&) As String Dim Pidl&, sPath As String * 260 If SHGetSpecialFolderLocation(0, lNum, Pidl) = 0 Then If SHGetPathFromIDList(ByVal Pidl, sPath) Then sPath = Left$(Trim$(sPath), InStr(sPath, Chr(0)) - 1) FindSysFolder = Trim$(sPath) End If End If End Function
Sub HistoryFolder() Dim HistoryFolder As String HistoryFolder = FindSysFolder(34) If Len(HistoryFolder) = 0 Then Exit Sub Application.ScreenUpdating = False Workbooks.Add Call FilesInFolder(HistoryFolder, 0, True) End Sub
Private Sub FilesInFolder(sFolderName As String _ , Optional Rw As Long = 0 _ , Optional SubDirs As Boolean = True) Dim FSO As Object, SourceFolder As Object Dim FileItem As Object, SubFolder As Object Dim FileType As String, n As String Set FSO = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FSO.GetFolder(sFolderName) Rw = Rw + 1 Cells(Rw, 1) = sFolderName Cells(Rw, 1).Font.Bold = True For Each FileItem In SourceFolder.Files Application.StatusBar = SourceFolder & FileItem.Name Rw = Rw + 1 Cells(Rw, 2) = FileItem.Name Next FileItem If SubDirs Then For Each SubFolder In SourceFolder.SubFolders Rw = Rw + 1 Call FilesInFolder(SubFolder.Path, Rw, True) Next SubFolder End If Application.StatusBar = False Columns("A:B").ColumnWidth = 1 Set FileItem = Nothing Set SubFolder = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
Par cette méthode, tu constateras la présence des fameux fichiers index.dat que tu ne vois pas en explorant le répertoire C:Documents and SettingsUsernameLocal SettingsHistorique. Maintenant, il te reste à écrire le module de lecture des fichiers index.dat dont il faut en premier lieu connaître la structure.
MP
"Albator V" a écrit dans le message de news:
Merci merci merci...
Et pour l'historique c'est possible ou pas ?
Bonjour Albator V;
Pour l'historique, c'est une autre paire de manche; l'historique est
conservé dans les fichiers index.dat des differents dossiers cache
d'internet explorer. Les fichiers index.dat sont normalement invisibles à
l'utilisateur même avec toutes les options d'affichage cochées dans les
options de dossier.
Tu peux lister le contenu de l'historique en utilisant:
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _
(ByVal hwnd As Long, ByVal nFolder As Long, Pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(Pidl As Long, ByVal FolderPath As String) As Long
Private Function FindSysFolder(ByVal lNum&) As String
Dim Pidl&, sPath As String * 260
If SHGetSpecialFolderLocation(0, lNum, Pidl) = 0 Then
If SHGetPathFromIDList(ByVal Pidl, sPath) Then
sPath = Left$(Trim$(sPath), InStr(sPath, Chr(0)) - 1)
FindSysFolder = Trim$(sPath)
End If
End If
End Function
Sub HistoryFolder()
Dim HistoryFolder As String
HistoryFolder = FindSysFolder(34)
If Len(HistoryFolder) = 0 Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Add
Call FilesInFolder(HistoryFolder, 0, True)
End Sub
Private Sub FilesInFolder(sFolderName As String _
, Optional Rw As Long = 0 _
, Optional SubDirs As Boolean = True)
Dim FSO As Object, SourceFolder As Object
Dim FileItem As Object, SubFolder As Object
Dim FileType As String, n As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(sFolderName)
Rw = Rw + 1
Cells(Rw, 1) = sFolderName
Cells(Rw, 1).Font.Bold = True
For Each FileItem In SourceFolder.Files
Application.StatusBar = SourceFolder & FileItem.Name
Rw = Rw + 1
Cells(Rw, 2) = FileItem.Name
Next FileItem
If SubDirs Then
For Each SubFolder In SourceFolder.SubFolders
Rw = Rw + 1
Call FilesInFolder(SubFolder.Path, Rw, True)
Next SubFolder
End If
Application.StatusBar = False
Columns("A:B").ColumnWidth = 1
Set FileItem = Nothing
Set SubFolder = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub
Par cette méthode, tu constateras la présence des fameux fichiers index.dat
que tu ne vois pas en explorant le répertoire C:Documents and
SettingsUsernameLocal SettingsHistorique. Maintenant, il te reste à
écrire le module de lecture des fichiers index.dat dont il faut en premier
lieu connaître la structure.
MP
"Albator V" <AlbatorV@discussions.microsoft.com> a écrit dans le message de
news: 0E04E2C1-CEAC-4503-A7CB-C469FFCFA809@microsoft.com...
Bonjour Albator V; Pour l'historique, c'est une autre paire de manche; l'historique est conservé dans les fichiers index.dat des differents dossiers cache d'internet explorer. Les fichiers index.dat sont normalement invisibles à l'utilisateur même avec toutes les options d'affichage cochées dans les options de dossier. Tu peux lister le contenu de l'historique en utilisant:
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _ (ByVal hwnd As Long, ByVal nFolder As Long, Pidl As Long) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" _ (Pidl As Long, ByVal FolderPath As String) As Long
Private Function FindSysFolder(ByVal lNum&) As String Dim Pidl&, sPath As String * 260 If SHGetSpecialFolderLocation(0, lNum, Pidl) = 0 Then If SHGetPathFromIDList(ByVal Pidl, sPath) Then sPath = Left$(Trim$(sPath), InStr(sPath, Chr(0)) - 1) FindSysFolder = Trim$(sPath) End If End If End Function
Sub HistoryFolder() Dim HistoryFolder As String HistoryFolder = FindSysFolder(34) If Len(HistoryFolder) = 0 Then Exit Sub Application.ScreenUpdating = False Workbooks.Add Call FilesInFolder(HistoryFolder, 0, True) End Sub
Private Sub FilesInFolder(sFolderName As String _ , Optional Rw As Long = 0 _ , Optional SubDirs As Boolean = True) Dim FSO As Object, SourceFolder As Object Dim FileItem As Object, SubFolder As Object Dim FileType As String, n As String Set FSO = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FSO.GetFolder(sFolderName) Rw = Rw + 1 Cells(Rw, 1) = sFolderName Cells(Rw, 1).Font.Bold = True For Each FileItem In SourceFolder.Files Application.StatusBar = SourceFolder & FileItem.Name Rw = Rw + 1 Cells(Rw, 2) = FileItem.Name Next FileItem If SubDirs Then For Each SubFolder In SourceFolder.SubFolders Rw = Rw + 1 Call FilesInFolder(SubFolder.Path, Rw, True) Next SubFolder End If Application.StatusBar = False Columns("A:B").ColumnWidth = 1 Set FileItem = Nothing Set SubFolder = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
Par cette méthode, tu constateras la présence des fameux fichiers index.dat que tu ne vois pas en explorant le répertoire C:Documents and SettingsUsernameLocal SettingsHistorique. Maintenant, il te reste à écrire le module de lecture des fichiers index.dat dont il faut en premier lieu connaître la structure.