determiner / trouver le chemin du bureau

[Nougat7]

Bonjour a tous!

je realise actuellement une macro qui sera utilisé par plusieurs personnes dans mon entreprise, il faut donc qu'elle soit au maximum portable.

A un moment de l'execution, je demande a l'utilisateur de choisir un dossier pour enregistrer ses resultats, j'ai trouvé une methode relativement simple qui permet cela mais qui a un probleme, c'est que l'on ne peut pas choisir le bureau comme repertoire d'enregistrement ce qui est fort penible...

Le chemin du bureau a comme syntaxe (pour mon ordi tout du moins):
C:\Documents and Settings\"login"\"nom de l'ordinateur"\Bureau

Dim ObjShell As Object, ObjFolder As Object
Dim SecuriteSlash As Integer
Dim Chemin As String

Set ObjShell = CreateObject("Shell.Application")
Set ObjFolder = ObjShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Chemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ""
If ObjFolder.Title = "Bureau" Then [COLOR="Red"]Msgbox "Choisisez un autre repertoire!"[/COLOR]
If ObjFolder.Title = "" Then Chemin = ""
SecuriteSlash = InStr(ObjFolder.Title, ":")
If SecuriteSlash > 0 Then Chemin = Mid(ObjFolder.Title, SecuriteSlash - 1, 2) & ""

j'ai donc pensé à plusieurs idées:

- remplacer le message affiché par ceci mais je suis pas sur que cela marche toujours

Chemin = "C:\Documents and Settings\All Users\Bureau"

- utiliser plusieurs variables d'environnement mais pareil, pas sur que ca marche toujours

Chemin = Environ("USERPROFILE") & "\" & Environ("COMPUTERNAME") & "\Bureau"

- ou alors utiliser la base de registre mais la ca sort de mes compétences

CSIDL_DESKTOPDIRECTORY = &H10

- autre solution, recupérer le resultat d'un ligne shell (cmd.exe) qui affiche sur mon ordi le chemin vers le bureau

prompt $P

laquelle de ces solution est la plus "portable" d'apres vous?

Pour la derniere on pourai me dire comment faire siouplait?

Merci

 

[Darnel]

Re : determiner / trouver le chemin du bureau

bonjour


Pour ma part, pour mon travail, j'ai utiliser la méthode suivante pour enregistrer par défaut sur le bureau :

Sub enrgistrer()
    Application.ScreenUpdating = False
       Dim utilisateur As String
    utilisateur = Application.UserName
    With ActiveWorkbook
        .SaveAs Fichier("D:\Documents and Settings\" & utilisateur & "\Desktop\", nom du fichier )
        .Close
    End With
    Range("B2").Select
    MsgBox "le fichier " & nom du fichier & " est enregistré sur votre bureau"
    Application.ScreenUpdating = True
End Sub

sinon, m'est avis que le All User devrait passer si cela est pour ton entreprise, a condition que cela te permette bien d'arriver sur le bureau, ce qui n'est pas évident si ta boite est une maniac de je protège tout (la mienne l'est )

 

[Ti_]

Re : determiner / trouver le chemin du bureau

Salut

Voici un ensemble de fonctions que j'utilise dans tous mes programmes dès lors que j'ai à manipuler des fichiers et à récupérer des noms de dossiers prédéfinis.
Je te conseille de recopier le code ci-dessous et de le mettre dans un module spécial que tu pourras reprendre tel quel chaque fois que tu en auras besoin

Option Explicit
'!Thierry Pourtier : xlti@wanadoo.fr
'!http://www.veriti.net

Public Type TFileName
  FFull As String
  FDrive As String
  FPath As String
  FName As String
  FBase As String
  FExt As String
End Type

Public Enum eSpecialFolder
  WindowsFolder = 0
  SystemFolder = 1
  TemporaryFolder = 2
End Enum

Private Type BrowseInfo
  hWndOwner As Long
  pIDLRoot As Long
  pszDisplayName As Long
  lpszTitle As Long
  ulFlags As Long
  lpfnCallback As Long
  lParam As Long
  iImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1, MAX_PATH = 260
Const CSIDL_PERSONAL = &H5, CSIDL_DESKTOPDIRECTORY = &H10

Private Declare Function FindWindow32& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem&)
Private Declare Function lstrcat& Lib "kernel32" Alias "lstrcatA" (ByVal lpString1$, ByVal lpString2$)
Private Declare Function SHBrowseForFolder& Lib "shell32" (lpbi As BrowseInfo)
Private Declare Function SHGetPathFromIDList& Lib "shell32" (ByVal pidList&, ByVal lpBuffer$)
Private Declare Function SHGetSpecialFolderLocation& Lib "shell32" (ByVal hWnd&, ByVal nFolder&, ppidl&)

Function ExistePath(ByVal P$) As Boolean
  On Error GoTo fin
  ExistePath = CreateObject("Scripting.FileSystemObject").FolderExists(P)
fin:
End Function

Public Function SpecFolder$(ByVal Folder&)
Dim Result&, FFound&, Pidl&, SPath$
  SPath = Space$(MAX_PATH)
  Result = SHGetSpecialFolderLocation(0, Folder, Pidl)
  If Result = 0 Then FFound = SHGetPathFromIDList(Pidl, SPath)
  If FFound Then SpecFolder = Left$(SPath, InStr(1, SPath, vbNullChar) - 1)
  CoTaskMemFree Pidl
End Function

Function GetMyFiles()
  GetMyFiles = SpecFolder(CSIDL_PERSONAL)
End Function
Function GetDeskTop()
  GetDeskTop = SpecFolder(CSIDL_DESKTOPDIRECTORY)
End Function
Function GetTempPath$()
  '!renvoie le chemin du dossier temp
  On Error GoTo fin
  GetTempPath = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2)
fin:
End Function
Function GetSpecialPath$(SpecPath As eSpecialFolder)
'!renvoie le chemin d'un dossier spécial (Windows-System-Temp)
  On Error GoTo fin
  GetSpecialPath = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(SpecPath)
fin:
End Function

Function GetFName$(ByVal PF$)
  '!renvoie le nom complet d'un fichier, sans le chemin
  On Error GoTo fin
  GetFName = CreateObject("Scripting.FileSystemObject").GetFileName(PF)
fin:
End Function
Function GetFBase$(ByVal PF$)
  '!renvoie le nom de base d'un fichier (avant le point)
  On Error GoTo fin
  GetFBase = CreateObject("Scripting.FileSystemObject").GetBaseName(PF)
fin:
End Function
Function GetFExt$(ByVal PF$)
  '!renvoie l'extension d'un nom de fichier (après le point)
  On Error GoTo fin
  GetFExt = CreateObject("Scripting.FileSystemObject").GetExtensionName(PF)
fin:
End Function
Function GetFPath$(ByVal PF$)
  '!renvoie le chemin complet d'un fichier
  On Error GoTo fin
  GetFPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(PF)
fin:
End Function
Function GetFDrive$(ByVal PF$)
  '!renvoie le lecteur d'un fichier
  On Error GoTo fin
  GetFDrive = CreateObject("Scripting.FileSystemObject").GetDriveName(PF)
fin:
End Function

Function BuildPath(ByVal PathF$, ByVal FileF$)
  '!construit un nom de fichier à partir du chemin et du nom
  On Error GoTo fin
  BuildPath = CreateObject("Scripting.FileSystemObject").BuildPath(PathF, FileF)
fin:
End Function

Function GetFileInfo(ByVal PF$) As TFileName
 '!renvoie en une seule fois toutes les infos d'un nom de fichier
Dim Fso As Object
  On Error GoTo fin
  Set Fso = CreateObject("Scripting.FileSystemObject")
  With GetFileInfo
    .FFull = PF
    .FPath = Fso.GetParentFolderName(PF)
    .FDrive = Fso.GetDriveName(PF)
    .FName = Fso.GetFileName(PF)
    .FBase = Fso.GetBaseName(PF)
    .FExt = Fso.GetExtensionName(PF)
  End With
fin:
End Function

Function BrowseForFolder$(ByVal Capt$)
Dim nNull%, lpIDList&, Result&, hWnd&
Dim SPath$, Msg$, BInf As BrowseInfo
  Msg = "Sélectionner le dossier de destination par défaut : "
  hWnd = FindWindow32(vbNullString, Capt)

  BInf.hWndOwner = hWnd
  BInf.lpszTitle = lstrcat(Msg, "")
  BInf.ulFlags = BIF_RETURNONLYFSDIRS
  lpIDList = SHBrowseForFolder(BInf)

  If lpIDList Then
    BrowseForFolder = Space$(MAX_PATH)
    Result = SHGetPathFromIDList(lpIDList, BrowseForFolder)
    CoTaskMemFree lpIDList
    nNull = InStr(BrowseForFolder, vbNullChar)
    If nNull Then BrowseForFolder = Left$(BrowseForFolder, nNull - 1)
  End If
End Function

 

[Nougat7]

Re : determiner / trouver le chemin du bureau

Re-bonjour,

La methode de Darnel (Application.UserName) ne convient pas vraiment pour mon cas car elle ne me donne que le "login" mais j'ai aussi besoin d'avoir le "nom de l'odinateur" donc cela revient a utilser la methode:

Chemin = Environ("USERPROFILE") & "\" & Environ("COMPUTERNAME") & "\Bureau"

en tous cas merci, cela pourra me servir peut etre plus tard

Mes 2 premieres methodes fonctionnent tres bien sur mon ordi et je pense que les 2 dernieres peuvent aussi bien marcher mais je sais pas si c'est mieux "portable"...
(entendez par portable le fait qu'une methode peut fonctionner sur differentes versions de windows, de excel, ordinateur personnel ou professionel, en francais ou anglais).

La methode de Ti_ me semble un poil complexe et pas top portable mais je m'avance un peu
Je n'ai pas eu le temps de tester mais j'essaye demain car la c'est l'heure de rentrer

En tout cas merci beaucoup pour vous deux qui avez repondu tres rapidement, n'hesitez pas si vous avez d'autres idées!

 

[MichelXld]

Re : determiner / trouver le chemin du bureau

bonjour à vous


une autre possibilité pour récupérer le chemin du bureau

Dim Chemin As String
Chemin = CreateObject("WScript.Shell").SpecialFolders("Desktop")
MsgBox Chemin

Bon week end
MichelXld