Discussion :

[raikko31]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 !

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

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[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 :/

[PMO2017]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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) ?

[Theze]

Bonjour,

Teste ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
MkDir (Chemin & "\_detail")

au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
MkDir (Chemin) & "\_detail"

Hervé.

[Invité]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.