Fonction pour créer un dossier avec des sous dossiers

Bonsoir le forum,

Erreur de syntaxe sur ce chemin:

strRep = "C:\Users\Devis clients\" & ActiveSheet.[I8] & "\Métrés"

Apparemment sa vient de "ActiveSheet.[I8]" car j'ai essayé sans et la sa fonctionne...

Problème, il me faut absolument la valeur de la cellule [I8] dans ce répertoire !!!

Si quelqu'un a une p'tite idée....

Bonsoir, avec ActiveSheet.Range("I8") peut-être ?

Bonsoir Oyobrans,

"ActiveSheet.Range("I8")" ne marche pas…

Avec les guillemets, effectivement... (Androïd...)

Si tu places :

MsgBox ActiveSheet.Name & vbcrlf & strRep

Ça t'affiche les infos souhaitées?

Oui effectivement, dans le MsgBox le chemin est correct...

Je comprend pas ou est le problème...

Le code entier au cas ou :

Function CréationPDFMétrés() As String

   Dim sRep As String                  ' Répertoire de sauvegarde du pdf
    Dim sFilename As String             ' Nom du pdf
    Dim strRep As String                ' Répertoire du dossier "Métrés"

    sRep = "C:\Users\Devis clients\" & ActiveSheet.[I8] & "\Métrés\"
    sFilename = "Métrés N°" & ActiveSheet.[F9] & "XXX" & "_" & ActiveSheet.[I8] & Format(Now, " (dd/mm/yyyy - hh'nn'ss)") & ".pdf"
    strRep = "C:\Users\Devis clients\" & ActiveSheet.[I8] & "\Métrés"

    CreateFolders strRep

    With Worksheets("Métrés")

        .ExportAsFixedFormat _
                     Type:=xlTypePDF, _
                     Filename:=sRep & sFilename, _
                     Quality:=xlQualityStandard, _
                     IncludeDocProperties:=True, _
                     IgnorePrintAreas:=False, _
                     OpenAfterPublish:=False
    End With

    ' On vérifie que le fichier a bien était créé
    If sRep = ("Métrés N°" & ActiveSheet.[F9] & "XXX" & "_" & ActiveSheet.[I8] & Format(Now, " (dd/mm/yyyy - hh'nn'ss)") & ".pdf") <> "" Then
        MsgBox "- Le dossier client a était créé avec succès!" & vbCrLf & _
                "- Le .pdf de ""Métrés"" a était créé avec succès!", vbInformation, "Infos..."
    Else
        MsgBox "ERREUR, Le .pdf de Métrés n'a pas était créé...", vbExclamation, "Ooups !"
    End If

End Function

et les deux macros pour créer les dossiers :

Function CreateFolder(ByVal strDossier As String)
    If Dir(strDossier, vbDirectory) = "" Then
        MkDir strDossier
    End If
End Function 

Function CreateFolders(ByVal strPath As String)
    Dim varFolders As Variant
    Dim varFolder As Variant
    Dim strTemp As String

    On Error GoTo CreateFoldersErr
    varFolders = Split(strPath, "")
    strTemp = ""

    For Each varFolder In varFolders
        If varFolder <> "" Then
            If strTemp <> "" Then strTemp = strTemp & ""
            strTemp = strTemp & varFolder

            CreateFolder strTemp
        End If
    Next
    Exit Function 

CreateFoldersErr:
    MsgBox Err.Description, vbExclamation
    Exit Function 
End Function 

C'est bon j'ai trouvé...

Le problème venait de fonction qui créée le dossier et le sous dossier...

Nouvelle fonction qui fonctionne très bien et qui créée un dossier et ses sous dossier en même temps, pour ceux qui seraient intéressés !

Function CreerRepertoire(Chemin As String)
'
'
On Error GoTo CreerRepertoireErreur

If Len(Dir(Chemin, vbDirectory)) > 0 Then
    CreerRepertoire = True
    Exit Function
Else
        If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1)
        PartiesDeChemin = Split(Chemin, Application.PathSeparator)

        For PartieDeChemin = LBound(PartiesDeChemin) To UBound(PartiesDeChemin)

            For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin
                CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator
                If CheminPartiel = PartieDeChemin Then
                    If Len(Dir(CheminPartielOK, vbDirectory)) = 0 Then
                        MkDir CheminPartielOK
                    End If
                End If
            Next CheminPartiel
            CheminPartielOK = ""
        Next PartieDeChemin
End If

CreerRepertoire = True
Exit Function
CreerRepertoireErreur:
CreerRepertoire = False
End Function

Pour appeler la fonction, mettre le répertoire a créer en paramètre...

ex:

Call CreerRepertoire ("C:\Users\Mes documents\Dossier1\Dossier2\Dossier3")