Discussion :

[toony63]

Bonjour a tous

J'ai un code qui fait des siennes un coup il marche et d'autre fois non

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
Private Sub Indiquer_dossier_stockage_Click()
Dim DossierAssurance As String
Dim fd As Office.FileDialog
 
If IsNull(Dossier_stockage) Then
 
DossierAssurance = "C:\TRAVAIL\Assurances\" & Compagnie & " " & Nom_Client & " " & Numero_dossier
 
 On Error GoTo Err
  'Créer le dossier Assurance si nécessaire
    MkDir DossierAssurance
 
  'Afficher les fichiers présents dans le dossier indiqué
Dossier_stockage = DossierAssurance
 
  'mise à jour case dossier stockage
Dossier_stockage.Requery
 
Me.Liste_fichiers.RowSourceType = "Liste valeurs"
Me.Liste_fichiers.RowSource = ShowFolderList(Dossier_stockage)
 
Err:
    Select Case Err.Number
        Case (2501)
           Exit Sub
   End Select
 
Else
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 
'Titre de la boîte de dialogue
fd.Title = "Sélectionnez un dossier..."
 
'Afficher la boîte de dialogue et traiter le résultat
If fd.Show() Then
End If
 
'Afficher les fichiers présents dans le dossier indiqué
On Error GoTo Err2
Dossier_stockage = fd.SelectedItems(1)
Me.Liste_fichiers.RowSourceType = "Liste valeurs"
Me.Liste_fichiers.RowSource = ShowFolderList(Dossier_stockage)
 
Err2:
    Select Case Err.Number
        Case (2501)
            Exit Sub
   End Select
 End If
End Sub

avez vous une idée d’où peux venir le problème ?
D'avance merci
Anthony

[Jean-Philippe André]

Salut,

pourrais-tu expliciter le "des fois oui des fois non" ? En effet, c'est un peu vague

Procédons par étapes :
- quel est l'objetif du code présenté ?
- quels sont les cas où cela fonctionne et quels sont les cas qui plantent ?
- quel est la structure des dossiers existants de le dossier TRAVAIL ?

[toony63]

Salut,

pourrais-tu expliciter le "des fois oui des fois non" ? En effet, c'est un peu vague

Alors des fois le code fonctionne parfaitement et crée le dossier et d'autre fois il ne créer absolument rien et passe au End Sub ....

quel est l'objetif du code présenté ?
quel est la structure des dossiers existants de le dossier TRAVAIL ?

Créé un sous-dossier dans le dossier : C:\TRAVAIL\Assurances\
avec comme nom de sous dossier [compagnie _ nom-client _ num-dossier] lors d'un click sur le bouton

exemple :


Merci d'avance

[Jean-Philippe André]

As-tu une combinaison qui plante à chaque fois ?

Je pense que des caractères interdits s'immiscent dans les libellés que tu voudrais pouvoir créer.

[marot_r]

Bonjour.

Voici le code que j'utilise pour faire cela :

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
Public Sub CreerUneHierarchieDeRepertoires(prmRepertoireAccesFichier As String)
 
    On Error GoTo Err_CreerUneHierarchieDeRepertoires
 
    Dim RepertoireAccesFichier As String: RepertoireAccesFichier = EpurerRepertoireFichier(prmRepertoireAccesFichier)
 
    '=== Gère le disque/serveur
    Dim disqueServeur As String
 
    If prmRepertoireAccesFichier Like "?:*" Then
            'il y a un mappage
            disqueServeur = Left(RepertoireAccesFichier, 2)
            RepertoireAccesFichier = Mid(RepertoireAccesFichier, 4)
    ElseIf prmRepertoireAccesFichier Like "\\*" Then
            'On utilise un nom de serveur
            disqueServeur = Left(RepertoireAccesFichier, InStr(3, RepertoireAccesFichier, "\") - 1)
            RepertoireAccesFichier = Mid(RepertoireAccesFichier, Len(disqueServeur) + 2)
        Else
            Error 5 'Ne devrait jamais se produire en prod
    End If
    '--- Gère le disque/serveur
 
    'Récupère la liste des répertoires qui compose le Repertoire
    Dim nomRepertoire As Variant: nomRepertoire = Split(RepertoireAccesFichier, "\")
 
    Dim Repertoire As String
 
    Repertoire = disqueServeur
 
    Dim i As Long: For i = LBound(nomRepertoire) To UBound(nomRepertoire)
        Repertoire = Repertoire & "\" & nomRepertoire(i)
 
'        If mdlGlobal.EST_MODE_DEBUG Then
'            Debug.Print Repertoire
'        End If
 
        MkDir Repertoire
    Next i
 
Exit_CreerUneHierarchieDeRepertoires:
    Exit Sub
 
Err_CreerUneHierarchieDeRepertoires:
    Select Case Err.Number
        Case 75
            'OK, le répertoire existe déjà passe au suivant
            Resume Next
 
        Case Else
            Err.Raise Err.Number
 
    End Select
 
    Resume Exit_CreerUneHierarchieDeRepertoires
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
Public Function EpurerRepertoireFichier(prmRepertoire As String) As String
    'Supprime les espaces non significatifs et le \ à la fin du Repertoire
    Dim result As String: result = Trim(prmRepertoire)
 
    If Right(result, 1) = "\" Then
        result = Left(result, Len(result) - 1)
    End If
 
    EpurerRepertoireFichier = result
End Function

Je lui passe le chemin complet et il crée tous les répertoires dont j'ai besoin.

Exemple d'utilisation.

Code :

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

1
2
3
Private Sub Test_CreerUneHierarchieDeRepertoires()
    Call CreerUneHierarchieDeRepertoires("x:\Toto\Titi\Tata)
End Sub

À date il ne m'a jamais fait défaut.

A+

[toony63]

bonsoir après plusieurs essai il ne bug plus

alors on verra bien

merci a Jean-Philippe André et marot_r
j'ai fait 2-3 modif dans le code et ça a l'air de fonctionner

Bonne soirée