Verifier existance dossier sinon le créer

bonjour à toutes et tous

je reviens vers vous afin de vous demander encore un peu d'aide.

Dans mon fichier sur la feuille "Factures" j'ai créer un bouton "Enregistrer" qui fait appel à une macro "enregister".

cette macro m'enregistre la facture dans un dossier année (exemple 2016,2017,2018 etc)

une msgbox me demande dans quel dossier enregistrer la facture.

le problème est que si le dossier n'est pas il ne sera pas créer et l'enregistrement ne se fera pas.

Comment peut on faire pour que lorsque l'on rentre l'année du dossier d'enregistrement dans la msgbox si celui ci n'existe pas il se créé automatiquement et que l'enregistrement se fasse et dans la cas ou il existe l'enregistrement se fasse.

je pense qu'il faille créer une boucle mais je suis un peu novice dans le vba

Merci pour votre aide

Bonjour ci joint une petite fonction qui test l'existence d'un dossier si il n'existe pas creation

modifier ton code en faisant appel a cette fonction

fred

Sub test_repertoire(chemin As String)
Dim fs As object

Set fs = CreateObject("Scripting.FileSystemObject")                                 ' initialisation de la variable

If fs.FolderExists(chemin) Then                                      ' le repertoire existe donc rien a faire
Else: fs.CreateFolder chemin                                        ' le repertoire n'existe pas donc on le créer
End If
Set fs = Nothing
End Sub

Sub enregistrer()
'
' enregistrer Macro
'
' boite dialogue dossier enregistrement
'
nomdossier = Application.InputBox(prompt:="ENTREZ ANNEE?", Type:=2)
dossier = "C:\Locations\" & nomdossier & "\"
test_repertoire (dossier)
'exportation en pdf sous forme facture_n°_client.pdf
    Sheets("Factures").Select
    Range("A1:H44").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$44"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        dossier & Range("F10").Value & "_" & "Facture_" & Range("C10") & "_" & Range("E2").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    Sheets("Factures").Select
    Range("A1:C1").Select
End Sub

bonjour à toutes et tous

bonjour Fred2406

désolé de répondre tardivement ....problème de santé me concernant

je vais tester le code et je vous tiens au courant

Merci pour votre aide

re bonjour,

bon j'ai essayer la fonction j'ai une erreur lors de l'exportation en pdf

je pense que j'ai fait une erreur lors de l'incorporation du code mais je ne vois trop où

voici la macro avec le code incorporé

Sub enregistrer()
'
' enregistrer Macro
'

' boite dialogue dossier enregistrement
'

nomdossier = Application.InputBox(prompt:="ENTREZ ANNEE?", Type:=2)

dossier = "C:\Locations\" & nomdossier & "\"
'test si dossier existe sinon création
Dim fs As Object

Set fs = CreateObject("Scripting.FileSystemObject")                                 ' initialisation de la variable

If fs.FolderExists(C:\Locations\) Then                                      ' le repertoire existe donc rien a faire
Else: fs.CreateFolder C:\Locations\                                        ' le repertoire n'existe pas donc on le créer
End If
Set fs = Nothing

'exportation en pdf sous forme facture_n°_client.pdf

    Sheets("Factures").Select
    Range("A1:H44").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$44"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        dossier & Range("F10").Value & "_" & "Facture_" & Range("C10") & "_" & Range("E2").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True

      Sheets("Factures").Select
    Range("A1:C1").Select

End Sub

bonjour

pourquoi ne pas laissé le code comme je l'ai fournit ?

voici le code complet a mettre dans un module

Fred

Sub enregistrer()
'
' enregistrer Macro
'
' boite dialogue dossier enregistrement
'
nomdossier = Application.InputBox(prompt:="ENTREZ ANNEE?", Type:=2)
dossier = "C:\Locations\" & nomdossier & "\"
test_repertoire (dossier)
'exportation en pdf sous forme facture_n°_client.pdf
   Sheets("Factures").Select
    Range("A1:H44").Select
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$44"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        dossier & Range("F10").Value & "_" & "Facture_" & Range("C10") & "_" & Range("E2").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    Sheets("Factures").Select
    Range("A1:C1").Select
End Sub
Sub test_repertoire(chemin As String)
Dim fs As object

Set fs = CreateObject("Scripting.FileSystemObject")                                 ' initialisation de la variable

If fs.FolderExists(chemin) Then                                      ' le repertoire existe donc rien a faire
Else: fs.CreateFolder chemin                                        ' le repertoire n'existe pas donc on le créer
End If
Set fs = Nothing
End Sub

Rebonjour fred2406

j'ai mis ton code dans la macro comme tu me l'as indiqué mais j'ai la même erreur

sans le code cela fonctionne bien mais je n'ai pas de vérification d'existence du dossier

re

question on est sur que le dossier "C:\Locations\" existe ou pas ???

sinon la vérification du dossier renseigné par msgbox est faite ici :

dossier = "C:\Locations\" & nomdossier & "\"
test_repertoire (dossier)

essai d’exécuter le programme en mode pas a pas pour vérifier le fonctionnement

car cela fonctione chez moi....

fred

re

oui le dossier "c:\Locations" existe bien

car quand j'exécute la macro sans ton bout de code la feuille est sauvegarder en pdf dans le dossier que l'on me demande de rentrer

je vais essayer de faire un pas a pas

je te tiens au courant

re

ça y est j'ai trouvé d'où cela venait.

j'avais oublié un bout de ton code en copiant collant

tu es un dieu

merci pour aide cela fonctionne nickel

je passe le sujet en résolu

Bonjour à vous tous

S'il vous plait, pourtant que j'ai essayé de suivre les solutions que vous avez partagé , j'arrive pas à gerer les dossier via VBA pour un sauvegarde de fichier dans un chemin relatif ou absolu

Est ce que vous pouvez me donner un coup de main ?

ce qui suit est mon code actuel, via lequel je sauvegarde mes rapports sur mon PC et ça fonctionne tres bien, sauf qu'en donnant le fichier à mes collègues, il y a erreur de chemin, car le mien est absolut

ChDir "C:\Users\DeptLog\Desktop\gestion de production\rapport du jour"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

"C:\Users\DeptLog\Desktop\gestion de production\rapport du jour\RAPPORT_de_PRODUCTION_pour " & Format(Date, "dd-mm-yyyy") _

, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

:=False, OpenAfterPublish:=True

ce que je cherche est d'avoir un code qui me permet la liste suivante des tâches:

1-Verification de l'existance du dossier ayant le chemin suivant: bureau de l' utilisateur en cours idépendamment du nom de son ordinateur/gestion de production/rapport du jour

2- si le dossier existe, donc il enregistre le fichier PDF, sinon il le crée puis enregistre le fichier PDF

voilà le code que j'ai essayé , mais toujour des erreurs de compilation:

Dim GestionFichier As New Scripting.FileSystemObject

If GestionFichier.FolderExists("C:\Users\Public\Desktop\gestion de production\rapport du jour") = False Then

GestionFichier.CreateFolder "C:\Users\Public\Desktop\gestion de production\rapport du jour"

End If

Set GestionFichier = Nothing

Erreur de compilation: Type Défini par l'utilisateur non défini

Comment Faire SVP ?

Merci

mon support en ligne pour Gestion des fichiers, dossiers et lecteurs: http://www.info-3000.com/vbvba/fichiers/index.php#ExistenceDossier

J'ai réussi à trouver la bonne solution, pourtant que je pense lourde en terme de complexité processeur

j'ai essayé de commenter tout le code pour plus de lisibilité

Public Function DossierExiste(MonDossier As String)

'Fonction publique pour Tester si le dossier Existe ou non, si oui retours True, sinon retous False
'fonction publique à utiliser apres de la part de sub "Bouton149_Cliquer()

   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function

Sub Bouton149_Cliquer()

Dim MonDossier As String

' pour recuperer le nom de l'utilisateur en cours et garantir la portabilité du code
NomDuPC_UtilisateurEnCours = Application.UserName

'definir le chemin de sauvegarde, chemin absolut
MonDossier = "C:\Users\" & NomDuPC_UtilisateurEnCours & "\Desktop\AtelierChafaa"

   ' si le dossier existe déjà donc exporter le fichier PDF avec les paramètres dates etc...
    If DossierExiste(MonDossier) = True Then
        'MsgBox "Le dossier existe..."

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        (MonDossier) & "\RAPPORT_de_PRODUCTION_pour  " & Format(Date, "dd-mm-yyyy") _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True

      'ouvrir le dossier de sauvegarde du fichier PDF avec l'explorateur windows
        Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus

    Else
        'MsgBox "Le dossier n'existe pas..."

        'si le dossier n'existe pas, donc le créer dans le chemin absolut adapté au nom d'utilisateur en cours
        MkDir "C:\Users\" & NomDuPC_UtilisateurEnCours & "\Desktop\AtelierChafaa"

        'apres avoir créer le dossier, exporter le fichier PDF
          ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        (MonDossier) & "\RAPPORT_de_PRODUCTION_pour  " & Format(Date, "dd-mm-yyyy") _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True

         'ouvrir le dossier de sauvegarde du fichier PDF avec l'explorateur windows
        Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus

        'Le paramètre vbNormalFocus ouvre le dossier dans une fenêtre normale qui sera active. Selon votre besoin, vous pouvez le remplacer par:
        'vbNormalNoFocus (taille normale, fenêtre pas active)
        'vbMaximizedFocus (taille maximisée, fenêtre active)
        'vbMinimizedFocus (taille minimisée, affichée comme une icône active)
        'vbMinimizedNoFocus (taille minimisée,  affichée comme une icône inactive)

        'créer un sous-dossier , car MKDIR ne permet pas la création d'arbiressance directement de plusieurs niveau
        MkDir "C:\Users\" & NomDuPC_UtilisateurEnCours & "\Desktop\AtelierChafaa\chafaa"
    End If

End Sub

bonjour Sgh.Chafaa

il aurait été plus simple de créer un nouveau sujet... plutôt que de reprendre un sujet d'une autre personne....

de plus inutile de m'envoyer 2 privés supplémentaires....

perso j'ai pas tout compris a ta demande... mais

1° si tu es utilisateur de ta machine tu ne pourras probablement pas écrire dans le bureau des allusers.... seulement de l'utilisateur connecté

2° suivant tes lignes de codes tu veux comme chemin :

"\Desktop\AtelierChafaa

ou

\Desktop\gestion de production\rapport du jour\

faut savoir.....

si dessous une proposition pour le second chemin...je te laisse corriger les noms des dossiers si necessaire...

fred

Sub enregistre()
Dim DD As String
'vérification que le dossier gestion de production existe sinon creation
DD = Environ("USERPROFILE") & "\desktop\gestion de production\"
If Dir(DD, vbDirectory) = "" Then MkDir DD
'vérification que le sous dossier rapport du jour existe sinon creation
DD = DD & "\rapport du jour\"
If Dir(DD, vbDirectory) = "" Then MkDir DD
'export pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DD & "RAPPORT_de_PRODUCTION_pour " & Format(Date, "dd-mm-yyyy") & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub

J'ai pensé qu’éviter la création d'un nouveau sujet et plus simple en terme de recherche pour les internautes sur google ( un seul sujet dans lequel il y a toutes les solutions possibles) sera plus efficace

Bref

autre solution par rapport à celle que j'ai trouvé hier, mais la tienne beaucoup plus simple

Merciii ^^