XL 2016 VBA Répertoire d'une bibliothèque

[Dudu2]

Bonjour,

VBA ... Y a-t-il un moyen de déterminer le répertoire d'une bibliothèque telle que par exemple Téléchargements (Downloads), Documents (Documents), Images (Pictures ?), Musique (Music), Vidéos (Videos) ?

Merci par avance.

 

[sylvanu]

Bonjour Dudu,
Au hasard essayez ça. Ca marche sur mon PC mais sans garantie que ça marche sur tous.

Sub essai()
    MsgBox "Documents : " & Application.DefaultFilePath & "\" & Chr(10) & _
        "Images : " & Replace(Application.DefaultFilePath, "Documents", "Pictures") & "\" & Chr(10) & _
        "Musique : " & Replace(Application.DefaultFilePath, "Documents", "Music") & "\" & Chr(10) & _
        "Videos : " & Replace(Application.DefaultFilePath, "Documents", "Videos") & "\"
End Sub

 

[Dudu2]

Bonjour @sylvanu,

Bien tenté, mais chez moi c'est différent les bibliothèques n'ont pas les emplacements par défaut.
Cependant l'Application.DefaultFilePath donne au moins les Téléchargements.
Merci

 

[sylvanu]

Désolé. Peut être qu'un esprit plus malin ....

 

[sylvanu]

Ai je le droit à un autre essai ?
( issu de https://forum.excel-pratique.com/excel/aide-chemin-d-acces-de-fichier-109837 )
Avec :

  Dim objShell As Object
  Dim objFolder As Object, objFolderItem As Object
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.Namespace(N)
  Set objFolderItem = objFolder.Self

 

[Dudu2]

Bien joué @sylvanu
Tu m'as aussi mis sur la piste des Special Folders.
Je vais essayer de creuser.

 

[sylvanu]

En faisant une boucle on peut en récupérer un peu plus.

 

[Dudu2]

Excellent, tu m'as devancé !

J'ai regroupé 2 méthodes dans ce fichier.
La méthode par NameSpace que tu utilises dans ton code est beaucoup plus exhaustive que celle que j'utilise par SpecialFolders.

Y a un truc que je n'aurais pas deviné sans ton code c'est cette chose qui vient de l'espace !

Set objFolderItem = objFolder.Self

 

[sylvanu]

par exemple Téléchargements (Downloads), Documents (Documents), Images (Pictures ?), Musique (Music), Vidéos (Videos)

Sauf si cela m'a échappé dans votre fichier, le problème avec SpecialFolders c'est qu'il ne remonte que Documents, mais pas Images,Musiques et Vidéos.
Et aucune des méthodes ne permet de trouver le chemin de Téléchargements.

 

[patricktoulon]

juste en passant
les index en hexa

Option Explicit
Const mes_documents& = &H5
Const ma_musiques& = &HD
Const mes_Images& = &H27
Const mes_videos& = &HE
Const Documents_Public& = &H2E
Const Musique_public& = &H35
Const Images_Public& = &H36
Const Video_public& = &H37
Const DeskTop_Folder& = &H19
Const App_Data_Roaming_Folder& = &H1A
Const App_Data_Local_Folder& = &H1C
Const Windows_Folder& = &H24
Const System32_Folder& = &H25
Const Progamme_file_x86_Folder& = &H26 ' ou &H2A
Const User_Folder& = &H28
Const SysWoW64_Folder& = &H29

Sub testX()
    MsgBox getPath(28)
 End Sub

Function getPath(x) As String
    getPath = ""
    On Error Resume Next
    getPath = CreateObject("Shell.Application").Namespace(x).self.Path
End Function

 

[Dudu2]

@sylvanu

Sauf si cela m'a échappé dans votre fichier, le problème avec SpecialFolders c'est qu'il ne remonte que Documents, mais pas Images,Musiques et Vidéos.

Oui c'est correct.
C'est pour ça que j'ai précisé que ta méthode donnait un résultat plus exhaustif.

Bonjour @patricktoulon,
Que les index soient en hexa ou en décimal, ça n'a pas d'importance et tu en as une liste qui n'est qu'un sous-ensemble. Regarde la feuille NameSpace du classeur que j'ai posté et tu en trouveras 49 au total (en excluant les ::{...}.

 

[patricktoulon]

re
Bonsoir @Dudu2
oui je les ai déjà ,j'utilise seulement ce que j'ai dans le code

Que les index soient en hexa ou en décimal, ça n'a pas d'importance

oulah !! non mon pauvre ami
surtout avec une variable numérique incrémentée dans une boucle
Attention en decimal selon la version d'excel ou de windows ça fonctionne pas toujours
la preuve en image

Function getPath(x) As String
    getPath = ""
    On Error Resume Next
    getPath = CreateObject("Shell.Application").Namespace(x).self.Path
    On Error GoTo 0
End Function

Sub testX2()
    Dim i As Long
    For i = 1 To 50
        Cells(i, 1) = i
        Cells(i, 2) = getPath(i)
    Next
End Sub

tandis qu'en hexa encodé en dur ça marche partout

 

[Dudu2]

En direct objShell.Namespace(vDir) ne fonctionne pas avec un Integer <i>, il attend un Variant.
Dans ce cas il faut lui passer un CVar(i).

De toutes façons je ne l'appelle pas en direct et passe un Integer <i> ByVal à une fonction qui attend un Variant et qui donc fait la conversion à ce niveau (même si j'ai laissé traîné un CVar(i) inutile)

 

[Dudu2]

J'ai rechargé le fichier du Post #8 car j'y ai écrit une bêtise.
On peut accéder aux SpecialFolders par leurs noms dans une variable à condition que cette variable soit un Variant (et pas un String)

objShell.SpecialFolders(CVar(TabSpecialFolderNames(i)))