Code pour accéder à n'importe quel disque dur

[pat01200]

Bonjour le forum,

Dans un classeur Excel, j'ai une macro destinée à générer un répertoire à la racine du disque dur pour y enregistrer ensuite un certains nombres d'autres fichiers, toujours générés par macro.
Code utilisé pour générer le répertoire :

MkDir "C:\Nouveau_répertoire"

Mon problème, c'est que ce fichier source doit être utilisé par plusieurs autres personnes et que si mon disque dur à moi est C:\, ce n'est pas le cas pour tout le monde : ce peut être D:\ ou E:\ ou F\...etc.

Quelqu'un aurait-il le code à mettre à la place de "C" pour que ma macro fonctionne sur n'importe quel poste, un truc du style

MkDir "Disque dur local:\Nouveau_répertoire" ???

Merci d'avance à toute personne ayant une solution !

 

[job75]

Re : Code pour accéder à n'importe quel disque dur

Bonjour pat01200,

Quelqu'un aurait-il le code à mettre à la place de "C" pour que ma macro fonctionne sur n'importe quel poste

A priori, il suffira d'omettre le nom du lecteur :

MkDir "\Nouveau_répertoire"

A+

 

[Gael]

Re : Code pour accéder à n'importe quel disque dur

Bonjour Pat, bonjour à tous,

Peut-être en utilisant le chemin par défaut précisé dans les options d'Excel:

Chemin = Application.DefaultFilePath
MkDir Chemin & "\Testdir"

ou celui contenant le fichier Excel:

Thisworkbook.path

@+

Gael

 

[PMO2]

Re : Code pour accéder à n'importe quel disque dur

Bonjour,

Une piste en recherchant la racine des dossiers spéciaux

  '///APIs///
Declare Function SHGetPathFromIDList& Lib "shell32.dll" ( _
  ByRef pidl As Long, ByVal pszPath As String)
Declare Function SHGetSpecialFolderLocation& Lib "shell32.dll" ( _
  ByVal hwnd As Long, ByVal csidl As Long, ByRef ppidl As ITEMIDLIST)

Const CSIDL_PROGRAMS As Long = &H2 'The file system directory that contains the user's program groups, which are also file system directories.
Const CSIDL_WINDOWS As Long = &H18 'The Windows folder.

  '/// Types ///
Type SHITEMID
  cb As Long
  abID As Byte
End Type
Type ITEMIDLIST
  mkid As SHITEMID
End Type

Sub votreCode()
MsgBox ObtenirLettreDisque & "Nouveau_répertoire"
'MkDir ObtenirLettreDisque & "Nouveau_répertoire"
End Sub


Function ObtenirLettreDisque() As String
Dim A$
Dim B$
'--- On contrôle 2 dossiers spéciaux différents ---
A$ = PathSpecial(CSIDL_WINDOWS)
A$ = Mid(A$, 1, InStr(1, A$, "\"))
B$ = PathSpecial(CSIDL_PROGRAMS)
B$ = Mid(B$, 1, InStr(1, B$, "\"))
If A$ <> B$ Then
  ObtenirLettreDisque = "ErreurLettreDisque "
Else
  ObtenirLettreDisque = A$
End If
End Function

Function PathSpecial(SpecialFolder As Long) As String
Dim Retour&
Dim A$
Dim IDL As ITEMIDLIST
  Retour& = SHGetSpecialFolderLocation(0, SpecialFolder, IDL)
  If Retour& = 0 Then
    A$ = Space(512)
    Retour& = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal A$)
    PathSpecial = Left(A$, InStr(A$, vbNullChar) - 1)
  End If
End Function

Cordialement.

PMO

 

[pat01200]

Re : Code pour accéder à n'importe quel disque dur

Merci à tous les 3 mais... malgré plusieurs essais, rien ne marche chez moi §

Je vais quand même essayer de bidouiller quelque chose à partir de vos codes...