Recherche nom dossier VBA

Version imprimable

Bonjour,

Actuellement sur un projet de Conception assistée par ordinateur sur le logiciel Catia V5, je suis en train de crée une macro permettant d'organiser les pièces conçues.

Pour cela, j'utilise l’éditeur Visual Basic présent dans Catia et qui utilise les ressources de VB6, ce qui equivaut à office 2000 si je ne me trompe pas.
De plus, ayant suivi une formation sans aucune programmation, je me retrouve un peu perdu au milieu de tout cet univers :p

Pour le moment, j'ai réussis à ouvrir un explorateur, permettant de créer le dossier "racine" comprenant un fichier d'assemblage de pièce.
Je dois maintenant y intégrer un sous dossier (comportant les pièces de l'assemblage). Jusque la tout va bien, je reprend le chemin précédent du dossier racine et peux y créer un sous dossier.

Le problème est que je voudrais reprendre le nom du dossier racine et y ajouter un "_détail" au nom. Et la, c'est le drame, impossible de trouver le moyen de le faire, je n'arrive pas a retrouver le nom que j'ai pourtant moi même entrer dans l'explorateur.

A savoir que cette action est dans un UserForm et déclenchée par un click bouton.

Je vous met le code ci dessous:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Private Sub bouton2_Click() Dim objShell As Object, objFolder As Object Dim SecuriteSlash As Integer Dim Chemin As String Set objShell = CreateObject("Shell.Application") 'recuperer nom repertoire cible Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&) On Error Resume Next Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path If objFolder.Title = "" Then Chemin = "" SecuriteSlash = InStr(objFolder.Title, ":") If SecuriteSlash > 0 Then Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & "" MkDir (Chemin) & "\_detail" '<== la ligne qui cloche :p End Sub
Merci d'avance :D

09/10/2013, 15h46
Marc-L

Bonjour,

en jetant un œil à l'aide intégrée de MkDir (premier réflexe à avoir ‼), je constate qu'il n'y a pas de parenthèse ! :roll:

Et si la variable Chemin se termine déjà par un "\" alors ne pas en ajouter un …

__________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …
09/10/2013, 15h57
raikko31

Pour ce qui est des parenthèses, ça marche avec ou sans. Initialement je ne les avais pas mises, mais je suis en train de tester tout pleins de choses, on ne sait jamais, sur un malentendu :p
Mais merci quand même :)

Le problème ne se situe pas au niveau de la création des dossier, car le sous dossier "_détail" se crée sans problèmes.
C'est juste que je n'arrive pas précéder le " _ " du nom du dossier précédent :/

Bonjour,

Je pense qu'il faut signifier le 4ème argument de la fonction BrowseForFolder.
Essayez le code suivant dans lequel il figure.
Le code semble long car j'y ai fait figurer, en commentaire, toutes les constantes de ce 4ème argument.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
'### Constantes du 4ème argument de BrowseForFolder ###
 
'ssfALTSTARTUP
'0x1d (29). File system directory that corresponds to the user's non-localized Startup program group.
'
'ssfAPPDATA
'0x1a (26). Version 4.71. File system directory that serves as a common repository for application-specific data. A typical path is C:\Documents and Settings\username\Application Data.
'
'ssfBITBUCKET
'0x0a (10). Virtual folder that contains the objects in the user's Recycle Bin.
'
'ssfCOMMONALTSTARTUP
'0x1e (30). File system directory that corresponds to the non-localized Startup program group for all users. Valid only for Windows NT systems.
'
'ssfCOMMONAPPDATA
'0x23 (35). Version 5.0. Application data for all users. A typical path is C:\Documents and Settings\All Users\Application Data.
'
'ssfCOMMONDESKTOPDIR
'0x19 (25). File system directory that contains files and folders that appear on the desktop for all users. A typical path is C:\Documents and Settings\All Users\Desktop. Valid only for Windows NT systems.
'
'ssfCOMMONFAVORITES
'0x1f (31). File system directory that serves as a common repository for the favorite URLs shared by all users. Valid only for Windows NT systems.
'
'ssfCOMMONPROGRAMS
'0x17 (23). File system directory that contains the directories for the common program groups that appear on the Start menu for all users. A typical path is C:\Documents and Settings\All Users\Start Menu\Programs. Valid only for Windows NT systems.
'
'ssfCOMMONSTARTMENU
'0x16 (22). File system directory that contains the programs and folders that appear on the Start menu for all users. A typical path is C:\Documents and Settings\All Users\Start Menu. Valid only for Windows NT systems.
'
'ssfCOMMONSTARTUP
'0x18 (24). File system directory that contains the programs that appear in the Startup folder for all users. A typical path is C:\Documents and Settings\All Users\Microsoft\Windows\Start Menu\Programs\StartUp. Valid only for Windows NT systems.
'
'ssfCONTROLS
'0x03 (3). Virtual folder that contains icons for the Control Panel applications.
'
'ssfCOOKIES
'0x21 (33). File system directory that serves as a common repository for Internet cookies. A typical path is C:\Documents and Settings\username\Application Data\Microsoft\Windows\Cookies.
'
'ssfDESKTOP
'0x00 (0). Windows desktop—the virtual folder that is the root of the namespace.
'
'ssfDESKTOPDIRECTORY
'0x10 (16). File system directory used to physically store the file objects that are displayed on the desktop. It is not to be confused with the desktop folder itself, which is a virtual folder. A typical path is C:\Documents and Settings\username\Desktop.
'
'ssfDRIVES
'0x11 (17). My Computer—the virtual folder that contains everything on the local computer: storage devices, printers, and Control Panel. This folder can also contain mapped network drives.
'
'ssfFAVORITES
'0x06 (6). File system directory that serves as a common repository for the user's favorite URLs. A typical path is C:\Documents and Settings\username\Favorites.
'
'ssfFONTS
'0x14 (20). Virtual folder that contains installed fonts. A typical path is C:\Windows\Fonts.
'
'ssfHISTORY
'0x22 (34). File system directory that serves as a common repository for Internet history items.
'
'ssfINTERNETCACHE
'0x20 (32). File system directory that serves as a common repository for temporary Internet files. A typical path is C:\Users\username\AppData\Local\Microsoft\Windows\Temporary Internet Files.
'
'ssfLOCALAPPDATA
'0x1c (28). Version 5.0. File system directory that serves as a data repository for local (non-roaming) applications. A typical path is C:\Users\username\AppData\Local.
'
'ssfMYPICTURES
'0x27 (39). My Pictures folder. A typical path is C:\Users\username\Pictures.
'
'ssfNETHOOD
'0x13 (19). A file system folder that contains any link objects in the My Network Places virtual folder. It is not the same as ssfNETWORK, which represents the network namespace root. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Network Shortcuts.
'
'ssfNETWORK
'0x12 (18). Network Neighborhood—the virtual folder that represents the root of the network namespace hierarchy.
'
'ssfPERSONAL
'0x05 (5). File system directory that serves as a common repository for a user's documents. A typical path is C:\Users\username\Documents.
'
'ssfPRINTERS
'0x04 (4). Virtual folder that contains installed printers.
'
'ssfPRINTHOOD
'0x1b (27). File system directory that contains any link objects in the Printers virtual folder. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Printer Shortcuts.
'
'ssfPROFILE
'0x28 (40). Version 5.0. User's profile folder.
'
'ssfPROGRAMFILES
'0x26 (38). Version 5.0. Program Files folder. A typical path is C:\Program Files.
'
'ssfPROGRAMFILESx86
'0x30 (48). Version 6.0. Program Files folder. A typical path is C:\Program Files, or C:\Program Files (X86) on a 64-bit computer.
'
'ssfPROGRAMS
'0x02 (2). File system directory that contains the user's program groups (which are also file system directories). A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Start Menu\Programs.
'
'ssfRECENT
'0x08 (8). File system directory that contains the user's most recently used documents. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Recent.
'
'ssfSENDTO
'0x09 (9). File system directory that contains Send To menu items. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\SendTo.
'
'ssfSTARTMENU
'0x0b (11). File system directory that contains Start menu items. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Start Menu.
'
'ssfSTARTUP
'0x07 (7). File system directory that corresponds to the user's Startup program group. The system starts these programs whenever any user first logs into their profile after a reboot. A typical path is C:\Users\username\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\StartUp.
'
'ssfSYSTEM
'0x25 (37). Version 5.0. The System folder. A typical path is C:\Windows\System32.
'
'ssfSYSTEMx86
'0x29 (41). Version 5.0. System folder. A typical path is C:\Windows\System32, or C:\Windows\Syswow32 on a 64-bit computer.
'
'ssfTEMPLATES
'0x15 (21). File system directory that serves as a common repository for document templates.
'
'ssfWINDOWS
'0x24 (36). Version 5.0. Windows directory. This corresponds to the %windir% or %SystemRoot% environment variables. A typical path is C:\Windows.
 
Private Sub bouton2_Click()
 
Const ssfCOMMONALTSTARTUP As Long = 30
 
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
'---
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Choisir un répertoire", &H1, ssfCOMMONALTSTARTUP) '/// ajout du 4ème argument
If Not objFolder Is Nothing Then
  Chemin = objFolder.Items.Item.Path
  MkDir (Chemin) & "\_detail"
End If
 
'--- Libération des objets ---
Set objFolder = Nothing
Set objShell = Nothing
End Sub

Cela fonctionne-t-il sous Excel2000 (j'ai fait le test sous 2003) ?

09/10/2013, 17h28
Theze
Bonjour,

Teste ceci :
Code:

1 2 MkDir (Chemin & "\_detail")
au lieu de :
Code:

1 2 MkDir (Chemin) & "\_detail"
Hervé.

Bonsoir,

tous les répertoire seront créés en cascade.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
sub test
Creer_Repertoires "C:\toto\titi\bibi"
Creer_Repertoires "C:\toto\zz\vv"
Creer_Repertoires "C:\toto\rr\hh\yy"
end sub
 
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Creer_Repertoires(NewRepertoires As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Dim T
Dim R As String
Dim I As Long
R = ""
T = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(T)
    If Trim("" & T(I)) <> "" Then
        R = R & Trim("" & T(I)) & "\"
        If Repertoires_Existe(R) = False Then Fso.CreateFolder R
    End If
Next
Set Fso = Nothing
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
 
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe(Repertoires As String) As Boolean
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Repertoires_Existe = Fso.FolderExists(Repertoires)
Set Fso = Nothing
End Function
'Taille d'un répertoire
Public Function Taille_Repertoire(Repertoire)
Dim Fso As Object
Dim Rep As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = Fso.GetFolder(Repertoire)
    Taille_Repertoire = Rep.Size
End Function
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires(NewRepertoires As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Dim T
Dim R As String
Dim I As Long
R = ""
T = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(T)
    If Trim("" & T(I)) <> "" Then
        R = R & Trim("" & T(I)) & "\"
        If Repertoires_Existe(R) = False Then Fso.CreateFolder R
    End If
Next
Set Fso = Nothing
End Sub
 
'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
Public Sub Copie_Repertoires(Source As String, Destination As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFolder Source, Destination, True
Set Fso = Nothing
End Sub
 
'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
Public Sub Deplace_Repertoire(Source As String, Destination As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.MoveFolder Source, Destination
Set Fso = Nothing
End Sub
 
'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
Public Sub Supprimer_Repertoire(DelRepertoire As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.DeleteFolder DelRepertoire, True
Set Fso = Nothing
End Sub
'Taille d'un Fichier
Public Function Taille_Fichier(Fichier)
Dim Fso As Object
Dim Fich As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fich = Fso.GetFile(Fichier)
    Taille_Fichier = Fich.Size
End Function
'Vérifie lexistance d'un   fichier
Public Function Fichier_Exist(Fichier As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fichier_Exist = Fso.FileExists(Fichier)
Set Fso = Nothing
End Function
'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_Name(Fichier As String)
Dim Fso As Object
If Fichier_Exist(Fichier) = True Then
Set Fso = CreateObject("Scripting.FileSystemObject")
Fichier_Name = Fso.GetBaseName(Fichier)
Set Fso = Nothing
End If
End Function
'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_extension(Fichier As String)
Dim Fso As Object
If Fichier_Exist(Fichier) = True Then
Set Fso = CreateObject("Scripting.FileSystemObject")
Fichier_extension = Fso.GetExtensionName(Fichier)
Set Fso = Nothing
End If
End Function
 
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier(Source As String, Destination As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.CopyFile Source, Destination, True
Set Fso = Nothing
End Sub
 
'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
Public Sub Deplace_Fichier(Source As String, Destination As String)
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.MoveFile Source, Destination
Set Fso = Nothing
End Sub
 
'Supprime le ou les fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier(DelFichier As String)
If Fichier_Exist(DelFichier) = True Then
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Fso.DeleteFile DelFichier, True
Set Fso = Nothing
End If
End Sub
Function AppendTxt(sFile, sText)
Dim Fso, NewFichier
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = Fso.OpenTextFile(sFile, 8)
 
NewFichier.Write sText
NewFichier.Close
 
Set NewFichier = Nothing
Set Fso = Nothing
 
End Function
 
Public Sub FichierLog(sFile, TXT)
Dim FichierLog, Fso
 
FichierLog = sFile
 
 
''CreerPath FichierLog
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
If Fso.FileExists(FichierLog) = False Then EnteteFichier FichierLog
 
AppendTxt FichierLog, TXT
 
Set Fso = Nothing
End Sub
 
Sub EnteteFichier(Fichier)
Dim TXT, Fso, NewFichier
 
TXT = ""
 'WScript.Echo Fichier
Set Fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = Fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write TXT
NewFichier.Close
 
 
Set NewFichier = Nothing
Set Fso = Nothing
End Sub

10/10/2013, 09h03
Docmarti

Bonjour raikko31.

Je n'aime pas ton On Error Resume Next
Car il t'empêche de savoir quelle erreur survient.

Enlève-le.
Et dis-moi quelle est la valeur de (Chemin)
et quel est le message d'erreur.

Cordialement

Docmarti.

Tout d'abord merci de vos réponse et désolé pour le retard, mais je n'ai l’éditeur Visual Basic qu'au travail, donc je viens de me replonger dedans il y a quelques minutes.

J'ai testé ta solution PMO, malheureusement cela ne fonctionne pas (toujours pas de nom de dossier en premier), de même que de mettre MkDir (Chemin & "\_detail") :/

Dans ce que tu a link Rdurupt, j'ai relevé le code qui pourrait peut-être m'aider (corrige moi si je me trompe):
Code:

1 2 3 4 5 6 7 8 Public Function Fichier_Name(Fichier As String) Dim Fso As Object If Fichier_Exist(Fichier) = True Then Set Fso = CreateObject("Scripting.FileSystemObject") Fichier_Name = Fso.GetBaseName(Fichier) Set Fso = Nothing End If End Function
Je ne sais cependant pas comment l’intégrer. A quoi correspondrait notamment "Fichier_Exist(Fichier).
De même que le Fso, est-il redondant ? Car j'ai déjà un CreateObject avec "Shell.application" et non Scripting.FileSystemeObject.

Veuillez m'excuser si ces questions peuvent paraître bateau mais ça doit faire une semaine à tout casser que je suis la dessus :/

Edit: je viens de voir ton message en envoyant le mien doc, je fais ça tout de suite et te dis :)

Edit 2: En enlevant le "On error resume next" le programme marche toujours, et je me retrouve, pour un dossier parent crée sur le bureau, C:\Documents and Settings\Anthony\Bureau\CHEMIN\_detail

Avec toujours ce fichu"_detail" qui ne veut pas devenir "CHEMIN_detail" :p

Bonjour,

Citation:

J'ai testé ta solution PMO, malheureusement cela ne fonctionne pas

Alors essayez le code suivant

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub bouton2_Click()
 
Const ssfCOMMONALTSTARTUP As Long = 30
 
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
'---
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Choisir un répertoire", &H1, ssfCOMMONALTSTARTUP) '/// ajout du 4ème argument
If Not objFolder Is Nothing Then
  Chemin = objFolder.Items.Item.Path
  objShell.Namespace(Chemin & "\").NewFolder "_detail"  '/// modif
End If
 
'--- Libération des objets ---
Set objFolder = Nothing
Set objShell = Nothing
End Sub

10/10/2013, 10h26
Invité
bonjour,
il n'y a rien de redondant, ce sont des fonction intépendantent utilisable en l'état.

si tu veux copier un répertoire vers une autre destination, tu fais:
Code:

1 2 3 4 5 6 7 8 9 Sub test() Copie_Repertoires "c:\MonRepSource","C:\MonRepCible" if Repertoires_Existe("c:\MonRepSource")=true then msgbox "Existe" else msgbox "Existe pas" end if End Sub
tu peux utiliser les fonction ou les sub indépendament. les variables Fso sont instenciées et dé-instencées automatiquement. se sont des utilitaires indépendant.

Citation:
Envoyé par PMO2017
Bonjour,

Alors essayez le code suivant
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Private Sub bouton2_Click() Const ssfCOMMONALTSTARTUP As Long = 30 Dim objShell As Object Dim objFolder As Object Dim Chemin As String '--- Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0&, "Choisir un répertoire", &H1, ssfCOMMONALTSTARTUP) '/// ajout du 4ème argument If Not objFolder Is Nothing Then Chemin = objFolder.Items.Item.Path objShell.Namespace(Chemin & "\").NewFolder "_detail" '/// modif End If '--- Libération des objets --- Set objFolder = Nothing Set objShell = Nothing End Sub
Toujours pas :s

Et je n'arrive toujours pas à intégrer le rappel du nom avec le public function.
Se met il à la suite de mon Private Sub ? Et faut il que j'y intègre une quelconque variable présente avant dans le code ?

10/10/2013, 12h15
Docmarti

Si tu veux créer le répertoire

C:\Documents and Settings\Anthony\Bureau\CHEMIN_detail

au lieu de

C:\Documents and Settings\Anthony\Bureau\CHEMIN\_detail

tu fais

Code:

MkDir Chemin & "_detail"

au lieu de

Code:

MkDir Chemin & "\_detail"

Cordialement

Docmarti
10/10/2013, 12h57
PMO2017

Chez moi cela marche très bien.
Etes-vous sûr d'avoir la Library Shell32 qui se trouve, pour mon cas, dans C:\WINDOWS\system32\SHELL32.dll ?
Je joins un classeur. Si d'autres personnes peuvent le tester et dire quel résultat ils obtiennent, je les remercie d'éclairer ma lanterne.
10/10/2013, 13h48
raikko31

Citation:

Envoyé par Docmarti

Si tu veux créer le répertoire

C:\Documents and Settings\Anthony\Bureau\CHEMIN_detail

au lieu de

C:\Documents and Settings\Anthony\Bureau\CHEMIN\_detail

tu fais

Code:

MkDir Chemin & "_detail"

au lieu de

Code:

MkDir Chemin & "\_detail"

Cordialement

Docmarti

Petite rectif', chemin_détail se trouve dans la dossier chemin. C'est la que le problème se trouve.

Sinon pour le shell32.dll, oui il est bien présent dans System32.
Pour ce qui est du fichier Excel, je ne trouve pas la macro dedans :s
.

Citation:

Petite rectif', chemin_détail se trouve dans la dossier chemin. C'est la que le problème se trouve.

J'avais mal compris votre demande et je ne suis toujours pas sûr d'avoir compris ; peut être que la piste ci-dessous va y répondre. Tentez de l'essayer.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub aa()
Const ssfDESKTOPDIRECTORY As Long = 16
 
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
Dim CheminSansInterdit As String
Dim NouveauDossier As String
'---
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Choisir un répertoire", &H1, ssfDESKTOPDIRECTORY)
If Not objFolder Is Nothing Then
 
  On Error Resume Next
  Chemin = objFolder.Items.Item.Path
  If Err <> 0 Then
    Chemin = objShell.Namespace(ssfDESKTOPDIRECTORY).Self.Path
    Err.Clear
  End If
  On Error GoTo 0
 
  '--- Retire les caractères interdits dans le nom d'un dossier ---
  CheminSansInterdit = Replace(Chemin, "\", "_")
  CheminSansInterdit = Replace(CheminSansInterdit, ":", "")
  NouveauDossier = CheminSansInterdit & "_detail"
  '-----------------------------------------------------------------
 
  objShell.Namespace(Chemin & "\").NewFolder NouveauDossier  '/// modif
End If
 
MsgBox NouveauDossier
'--- Libération des objets ---
Set objFolder = Nothing
Set objShell = Nothing
End Sub

11/10/2013, 08h26
raikko31

Celui la est bien. Juste une petite chose, le nom du fichier retourné dans la message box reprend tout le chemin, depuis le disque C:.

Y aurait-il un moyen de ne garder que le dossier précédent ?

En tout cas merci bcp de m'aider, pcq ce n'est vraiment pas facile comme langage, même avec les millions d'aide présentent sur internet.
11/10/2013, 11h33
PMO2017

Citation:

Y aurait-il un moyen de ne garder que le dossier précédent ?

Remplacez

Code:

MsgBox NouveauDossier

par

Code:

MsgBox Mid(Chemin, InStrRev(Chemin, "\") + 1)