Ouvrir plusieurs pages IE répertoriées dans les favoris

bonjour

j'espere que cet exemple ( qui ouvre dans un nouvelle fenetre tous les liens
du dossier "Favoris" ) pourra t'aider


Sub listerLiensDansFavoris()
'testé avec Excel2002 & WinXP
'necessite d'activer la reference Microsoft Shell Controls and Automation
Const Cible = &H6 'Dossier Favoris

Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim colItems As Shell32.FolderItems
Dim objItem As Shell32.FolderItem
Dim i As Integer

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(Cible)
'
'exemple pour un autre dossier
'Set objFolder = objShell.NameSpace("C:Documents and
SettingsmichelFavorismonDossier")
'
Set colItems = objFolder.Items

For Each objItem In colItems
If objItem.IsLink Then ActiveWorkbook.FollowHyperlink objItem.GetLink.Path,
NewWindow:=True
Next
End Sub


bonne soiree
michel


"forums" wrote:

Bonjour,
Est-il possible d'ouvrir toutes les adresses d'un dossier des favoris,
chacun dans une fenêtre internet explorer différente, tout ça bien sûr
dans une macro xl ?
En fait mon problème n'est pas d'ouvrir une url précise avec ie, mais
bien de retrouver toutes les adresses du dossier des favoris.
Merci !

Bonjour.

Sub ListeFile()
Dim ObjFolder, WS As Worksheet, NbItem As Long
Dim MaCol As New Collection, I As Long
Set ObjFolder = CreateObject("Shell.Application").NameSpace(6)
Populate ObjFolder, MaCol, True
NbItem = MaCol.Count
Set WS = Worksheets.Add
For I = 1 To NbItem
WS.Range("A" & I).Value = MaCol.Item(I)
Next I
WS.Range("A1:A" & NbItem).Columns.AutoFit
Set WS = Nothing
Set ObjFolder = Nothing
End Sub

Function Populate(ObjFolder, MaCol As Collection, Optional Recurs As Boolean)
Dim FolderItem, ObjFolderChild
For Each FolderItem In ObjFolder.Items
If FolderItem.IsFolder Then
Set ObjFolderChild = FolderItem.GetFolder
Populate ObjFolderChild, MaCol, True
Set ObjFolderChild = Nothing
Else
MaCol.Add LeLien(FolderItem.Path)
End If
Next FolderItem
Set FolderItem = Nothing
End Function

Function LeLien$(Filename$)
Dim Num&, Lien$
Num = FreeFile
Open Filename For Input As #Num
Do While Not EOF(Num)
Input #Num, Lien
If UCase$(Left$(Lien, 4&)) = "URL=" Then
LeLien = Right$(Lien, Len(Lien) - 4&)
Exit Do
End If
Loop
Close #Num
End Function

Alain CROS

"forums" <electionsdp@voila.fr> a écrit dans le message de news: 424d9ef2$0$11806$626a14ce@news.free.fr...

Bonjour,
Est-il possible d'ouvrir toutes les adresses d'un dossier des favoris,
chacun dans une fenêtre internet explorer différente, tout ça bien sûr
dans une macro xl ?
En fait mon problème n'est pas d'ouvrir une url précise avec ie, mais
bien de retrouver toutes les adresses du dossier des favoris.
Merci !

Bonjour,

Méthode avec les API. Pourquoi faire simple ? ;-)
Les Favoris; dont on ne voit pas l'extension .url, réagissent comme des
.ini à l'API 'GetPrivateProfileString'
----------------------------------------------------------------------
Private Const HKCU = &H80000001

Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const REG_SZ = 1&

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal
ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal lpReserved As Long, lpType As Long, ByVal lpData As String,
lpcbData As Long) As Long

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias
"GetPrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName
As Any, ByVal lpDefault As String, ByVal lpReturnedString As String,
ByVal nSize As Long, ByVal inifile As String) As Long

Private Const SW_SHOWMAXIMIZED = 3
Private Declare Function ShellExecute Lib "Shell32.dll" Alias
"ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal
lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String, ByVal nShowCmd As Long) As Long

Private Sub CommandButton1_Click()
Dim FavRep As String
Dim Favs As String, Url As String
Dim Rep As String

FavRep = Read_RegistryString(HKCU,
"SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders",
"Favorites")
Favs = Dir(FavRep & "" & "*.*", vbNormal)
While Len(Favs) > 0
If Right(Favs, 3) = "url" Then
Url = Space(256)
GetPrivateProfileString "InternetShortcut", "URL", "", Url,
Len(Url), FavRep & "" & Favs
Rep = MsgBox("Voulez vous ouvrir : " & Favs & vbCrLf & Url,
vbYesNo Or vbQuestion)
If Rep = vbYes Then
ShellExecute 0&, "open", FavRep & "" & Favs, 0, 0,
SW_SHOWMAXIMIZED
End If
End If
Favs = Dir()
Wend

End Sub

' Lecture Base de registre 'String'
' ---------------------------------
Private Function Read_RegistryString(hKey As Long, SubKey As String,
Name As String) As String
Dim Temp As String
Dim lResult As Long, strLen As Long
Dim keyType As Long
Dim phkResult As Long

Read_RegistryString = ""
strLen = 256
Temp = Space(strLen)

lResult = RegOpenKeyEx(hKey, SubKey, 0&, KEY_READ, hKey)
If lResult = 0 Then
lResult = RegQueryValueEx(hKey, Name, 0&, keyType, Temp, strLen)
If lResult = 0 Then
If InStr(Temp, Chr$(0)) = 0 Then
Read_RegistryString = ""
Else
Read_RegistryString = Left(Temp, InStr(Temp, Chr$(0)) - 1)
End If
Else
Read_RegistryString = ""
End If
lResult = RegCloseKey(hKey)
Else
Read_RegistryString = ""
End If
If phkResult <> 0 Then lResult = RegCloseKey(phkResult)
End Function
----------------------------------------------------------------------

forums wrote:

Bonjour,
Est-il possible d'ouvrir toutes les adresses d'un dossier des favoris,
chacun dans une fenêtre internet explorer différente, tout ça bien sûr
dans une macro xl ?
En fait mon problème n'est pas d'ouvrir une url précise avec ie, mais
bien de retrouver toutes les adresses du dossier des favoris.
Merci !

--
Cordialement,

Jacques.