Ajouter des favoris
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 : Laurent Longre
Mot clef associé à cette page : adresse
- Vous devez vous identifier ou créer un compte pour écrire des commentaires
