Ajouter des favoris

J'ai un tableau qui recense des sites Web avec le nom du site dans une colonne et son adresse dans une autre. Je voudrais faire une macro qui génère une liste de favoris à partir de ça.

En supposant que les noms commencent dans la cellule A2 (sinon change le contenu de la constante PremCell):

Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
(ByVal hwnd As Long, ByVal nFolder As Long, ppidl As Long) As Long

Private Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal Pidl As Long, ByVal pszPath As String) As Long

Const PremCell = "A2"
sub AjoutFavoris()
 Dim Pidl As Long, Fav As String
 Dim Cell As Range
 SHGetSpecialFolderLocation 0, 6, Pidl
 Fav = Space(260)
 SHGetPathFromIDList Pidl, Fav
 Fav = Left(Fav, InStr(1, Fav, vbNullChar) - 1) & ""
 With Range(PremCell, Range(PremCell).End(xlDown))
  For Each Cell In .Cells
   Open Fav & Cell & ".url" For Output As 1
   Print #1, "[InternetShortcut]"
   Print #1, "URL=" & Cell(, 2)
   Close 1
  Next Cell
  MsgBox .Count & " favoris créés.", vbInformation
 End With
 end sub

Et en faisant la macro inverse, on peut aussi récupérer les favoris dans une feuille Excel.

Auteur :

Mot clef associé à cette page :