Création d'un répertoir si inexistant

Bonjour le forum,

Je voudrais savoir s’il est possible de vérifier l’existence ou non d’un répertoire et s’il n’existe pas de le créer. Dans l’extrait du code ci-dessous j’ai besoin de deux répertoires un qui s’appelle « sauvegarde pour SITE » et un autre qui s’appelle « Sauvegarde fichier travail ». Dans le cas où ils existent tout va bien mais si ce n’est pas le cas j’ai un message d’erreur et la macro s'arrête lorsque je lance la sauvegarde. Pour éviter ce « désagrément » est-il possible que mon code vérifie l’existence de ces répertoires et de les créer s’il n’existe pas de façon à ce que le message d’erreur n’apparaisse pas lors de la sauvegarde ?

Sub navette()

Dim sPath As String, sPath1 As String, sFilename As String, sFilename1 As String

Application.ScreenUpdating = False

Position = ActiveCell.Address

        'initiation des répertoires et des noms des fichiers à copier.

    sPath = "C:\Users\" & Environ("username") & "\Documents\sauvegarde pour SITE \"
    sPath1 = "C:\Users\" & Environ("username") & "\Documents\Travail\Sauvegarde fichier travail\"

    sFilename = Format(Date, "yyyymmdd") & "_" & Hour(Now()) & "_" & Minute(Now()) & "PLT-AER"
    sFilename1 = Format(Date, "yyyymmdd") & "_sauvegarde_de_secours_ PLT-AER" & ".xlsm"

    […………]

Je ne sais pas si j'ai été clair....mais merci par avance à ceux qui pourront m'apporter une réponse.

Cordialement

Bonjour,
Une proposition à adapter.
Cdlt.

Public Sub CreateFolders()
Dim sPath As String
Dim sFolder As String, sFolder2 As String
Dim sFilename As String, sFilename2 As String

    sPath = "c:\users\" & Environ("username") & "\documents\"

    sFolder = sPath & "Sauvegarde pour SITE"
    If FolderExists(sFolder) = False Then MkDir sFolder

    sFolder2 = sPath & "Travail"
    If FolderExists(sFolder2) = False Then MkDir sFolder
    sFolder2 = sPath & "\Travail\Sauvegarde fichier travail"
    If FolderExists(sFolder2) = False Then MkDir sFolder

End Sub

Private Function FolderExists(sFolder As String) As Boolean
    If Len(Dir(sFolder, vbDirectory)) = 0 Then
        FolderExists = False
    Else
        FolderExists = True
    End If
End Function

Merci Jean-Eric pour ta solution que j'ai pu adapter et qui me créer bien le répertoire quand il n'existe pas. Une question j'ai remarqué que si je veux adapter d'autre macro sauvegardes dans des modules différent je dois copier la macro fonction

Private Function FolderExists(sFolder As String) As Boolean

dans ces modules sinon ça ne marche pas. Y-a-t-il une solution différente que de copier plusieurs fois la même fonction qui alourdie la macro ?

Sinon je mets le sujet en résolu et merci encore pour ta réponse.

Bonjour,
Remplace Private par Public et mets cette fonction dans un module standard.
Cdlt.

Merci Jean-Eric pour ton retour 😊

Bonjour à tous,

sinon, sans fonction personnalisée :
If Dir(sFolder, vbDirectory) = "" Then MkDir sFolder
eric

Merci eriiic pour ton info complémentaire. C'est toujours sympa d'avoir plusieurs solutions à disposition 😉

Bonjour,
@Eriiic,
C'est toujours un plaisir de te lire.
Bonne journée.
Cdlt.

Rechercher des sujets similaires à "creation repertoir inexistant"