Prôbleme de chemin d'enregistrement

Bonjour,

J'ai un chemin pour l'enregistrement de pièces en PDF, le chemin fonctionne en MsgBox (Fichier joint), cependant à l'exécution de la macro, qu'une seule partie du chemin est construit:

La c'est le MsgBox du code :

Et le chemin final d'enregistrement s'arrête à :

S:\Logistique\Facturation RQ\FACTURATION LOGISTIQUE RQ\2026\562 072 678 00179\

Il n'arrive pas à me prendre le mois que je souhaite intégrer.

Voici le code VBA :

Sub ArchivePDF()

On Error Resume Next
Application.ScreenUpdating = False

chemin = Sheets("Paramètres").Range("AF5") & Sheets("Facturation").Range("N6") & "\" & Sheets("Récap").Range("F4").Text & "\" & Sheets("Facturation").Range("BZ11").Value

DossierExistant = GetAttr(Dossier) And vbDirectory

MsgBox chemin

If DossierExistant = False Then
    MkDir (chemin)
End If

'-----------1ERE FACTURE-----------------------
Columns("D:ZZ").EntireColumn.Hidden = False
If Sheets("Facturation").Range("H6") <> "" Then
'Sheets("Facturation").Unprotect
    Range("F2:F97").Select
'Sheets("Facturation").Unprotect
    ActiveSheet.PageSetup.Orientation = xlPortrait
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & Sheets("Facturation").Range("M4").Value & " - " & Sheets("Facturation").Range("H6").Value & " - " & Sheets("Facturation").Range("N5").Value & Range("N6").Value & ".pdf", quality:= _
    xkqualitystandard, includedocproperties:=True, ignoreprintareas:=False, _
    from:=1, To:=1, openafterpublish:=False
End If
End sub

Cela fait plusieurs jours que je suis sur cette difficulté, mais je n'arrive pas à comprendre pourquoi il prend qu'une seul partie du chemin.

Si quelque à une idée je suis preneur !

RQ

Bonjour

A tester

Sub ArchivePDF()

    On Error Resume Next
    Application.ScreenUpdating = False

    Dim chemin As String
    Dim DossierExistant As Boolean

    ' Construction du chemin
    chemin = Sheets("Paramètres").Range("AF5").Value & Sheets("Facturation").Range("N6").Value & "\" & _
             Sheets("Récap").Range("F4").Text & "\" & Sheets("Facturation").Range("BZ11").Value

    ' Vérification de l'existence du dossier
    DossierExistant = (Dir(chemin, vbDirectory) <> "")

    MsgBox chemin  ' Affichage du chemin pour vérification

    If Not DossierExistant Then
        MkDir chemin  ' Création du dossier si inexistant
    End If

    '-----------1ERE FACTURE-----------------------
    Columns("D:ZZ").EntireColumn.Hidden = False
    If Sheets("Facturation").Range("H6").Value <> "" Then
        'Sheets("Facturation").Unprotect
        Range("F2:F97").Select
        'Sheets("Facturation").Unprotect
        ActiveSheet.PageSetup.Orientation = xlPortrait

        ' Exportation en PDF
        Selection.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=chemin & Sheets("Facturation").Range("M4").Value & " - " & _
            Sheets("Facturation").Range("H6").Value & " - " & _
            Sheets("Facturation").Range("N5").Value & Sheets("Facturation").Range("N6").Value & ".pdf", _
            Quality:=xlQualityStandard, Includedocproperties:=True, Ignoreprintareas:=False, _
            From:=1, To:=1, Openafterpublish:=False
    End If

End Sub

Hello,

Le problème ne vient pas de la concaténation ça ça fonctionne correctement.

Le problème c'est avec la création du sous dossier si ça n'existe pas. Mkdir ne sait créer qu'un dossier à la fois pas plusieurs, donc il faut boucler sur toutes les parties du chemin et tester si ça existe ou pas, et on crée le sous dossier si nécessaire, comme ça problème réglé et pas besoin de passer par cette ligne qui je pense ne fonctionne pas mais l'erreur est masquée par ton On error resume next plus haut.

DossierExistant = GetAttr(Dossier) And vbDirectory

J'aurai utilisé ça plutôt parce que tu testes pas la variable "Dossier" (qui n'est pas déclarée dans le code) mais la variable "chemin"

DossierExistant = (GetAttr(chemin) And vbDirectory) = vbDirectory

Du coup essaie ça :

Sub ArchivePDF()

    Application.ScreenUpdating = False

    Dim chemin As String
    Dim parties() As String
    Dim cheminTemp As String
    Dim i As Long

    chemin = Sheets("Paramètres").Range("AF5").Value & Sheets("Facturation").Range("N6").Value & "\" & Sheets("Récap").Range("F4").Text & "\" & Sheets("Facturation").Range("BZ11").Value & "\"

    'MsgBox chemin

'Permet de boucler sur toutes les parties du chemin puisque tu l'as déjà construit, et on fait un mkdir sur tous les dossiers/sous dossiers qui n'existent pas
    parties = Split(chemin, "\")
    cheminTemp = parties(0) & "\"

    For i = 1 To UBound(parties)
        cheminTemp = cheminTemp & parties(i) & "\"
        If Dir(cheminTemp, vbDirectory) = "" Then
            MkDir cheminTemp
        End If
    Next i

    '----------- EXPORT PDF -----------------------
Sheets("Facturation").Columns("D:ZZ").EntireColumn.Hidden = False
    If Sheets("Facturation").Range("H6") <> "" Then
        Sheets("Facturation").Range("F2:F97").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=chemin & _
            Sheets("Facturation").Range("M4").Value & " - " & _
            Sheets("Facturation").Range("H6").Value & " - " & _
            Sheets("Facturation").Range("N5").Value & _
            Sheets("Facturation").Range("N6").Value & ".pdf", _
            Quality:=xlQualityStandard, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    End If

Application.ScreenUpdating = True

End Sub

@+

Edit : Joco,

Bonjour BAROUTE78,

Ok je ne savait pas que la création de sous-dossier ne fonctionnait pas plusieurs fois !

Je viens de tester le code et tout fonctionne parfaitement ! Merci beaucoup !!!!

Hey !

Merci pour le retour

@+