OVH Cloud OVH Cloud

Lister mes favoris...

3 réponses
Avatar
Albator V
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 ?

3 réponses

Avatar
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 ?


Avatar
Albator V
Merci merci merci...

Et pour l'historique c'est possible ou pas ?
Avatar
Michel Pierron
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 ?