Vérifier si le dossier existe avant de le créer

matthieu2701 · 5 Août 2013

Bonjour,

Je souhaite créer le dossier d'un client. A l'intérieur je mettrais différents fichiers word, pdf ...

J'ai réussi à créer le dossier avec une msgbox mais je n'arrive pas à arrêter la macro si le le dossier est déjà créé et à faire afficher une msgbox du style "Le dossier est déjà créé"

La macro s'appelle "Dossier" dans mon fichier.

Ne faites pas attention au chemin d'enregistrement du fichier. Il vous paraitra bizarre mais c'est normal car je vais mes tes sur Mac.

Merci par avance pour votre aide.

Herdet · 9 Août 2013

Re : Vérifier si le dossier existe avant de le créer

matthieu2701 à dit:
Je viens de tester. J'ai une erreur sur ==> If Dir(Chemin, vbDirectory) = "" Then

Sur PC, Excel 2010, tout est ok.
Tu es sur PC ou Mac ?
si tu es sur Mac regarde l'aide en ligne de Dir si cette commande existe, ce qui n'est pas gagné.

matthieu2701 · 9 Août 2013

Re : Vérifier si le dossier existe avant de le créer

Herdet à dit:
Sur PC, Excel 2010, tout est ok.
Tu es sur PC ou Mac ?
si tu es sur Mac regarde l'aide en ligne de Dir si cette commande existe, ce qui n'est pas gagné.

Là je suis sur Mac. Au boulot, sur PC et sur excel 2007. Je testerai lundi au boulot. Merci

J'ai un autre soucis. Je souhaite, dans la feuille "Copie" mettre 4 ou 5 copies d'écran de dossier client. Je souhaite qu'ensuite elle se colle dans Word puis dans le chemin où est le dossier client.

Les copies d'écran se colle bien dans Word et le Word s'enregistrer bien dans le dossier voulu. Par contre, les copies d'écran apparaissent toute petite.

La macro est "Ecran".

Peux tu regarder stp ?

J'ai mis de nouveau le fichier excel car il a évolué par rapport au début du post.

Merci

matthieu2701 · 12 Août 2013

Re : Vérifier si le dossier existe avant de le créer

BrunoM45 à dit:

Bonjour le fil, salut matthieu2701

Perso, je mettrais le code après la création du chemin

Code:

' ....<
    'Chemin d'enregistrement de l'engagement de paiement    Chemin = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & Ref & "" & Nom & " Engagement de Paiement"
    
    ' Vérifier si le fichier existe
    If Dir(Chemin) <> "" Then
      If MsgBox("Un document avec ce nom existe déjà, Voulez vous remplacer l'ancien ?", _
        vbQuestion + vbYesNo, "QUESTION ...") = vbNo Then Exit Sub
      ' Si la réponse est oui on supprime le fichier
      Kill Chemin
    End If


    'Si les champs ne sont pas remplis affichier msgbox sinon éxécuter la suite
    If Adresse = "" Or Nom = "" Or Ref = "" Or Dette = "" Or Dates = "" Or Echéances = "" Or Début_DP = "" Then
      MsgBox "Veuillez compléter tous les champs avant de créer l'engagement de paiement.", vbOKOnly + vbCritical, "Attention"
      Exit Sub
    End If
' > ....

A+

Le message n'apparaît pas et il remplace automatiquement l'ancien.

matthieu2701 · 12 Août 2013

Re : Vérifier si le dossier existe avant de le créer

Herdet à dit:
Bonjour,

Avant de lancer une Userform, il faut vérifier que le répertoire existe par la fonction Dir
Ci-joint ton fichier modifié pour utiliser les fonctions Dir, Mkdir et Chdir .. qui devraient aussi exister sur Mac.
Procédure : Sub Dossier_creation()

A+
Robert

J'ai essayé de l'adapter sur la macro "ecran" et "exportword" sur le PC au boulot mais ca fonctionne pas.

PHP:

Sub ecran()

Dim WdApp As Object, WdDoc As Object

With Sheets("Echéancier")
    Ref = .Range("B1")
    Nom = .Range("B2")
    
End With

Chemin = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & Ref & "\" & Nom

With Sheets("Copie").Range("A1:J170")
    .Copy
End With


'Lancer une instance Word
Set WdApp = CreateObject("Word.Application")
'Rendre Word visible
WdApp.Visible = True
'Ouvrir le document Word
Set WdDoc = WdApp.Documents.Open(ThisWorkbook.Path & "\" & "Masque.doc") 'indiquer le chemin du fichier modèle
With WdDoc
'Copie de la feuille 4 Excel
    'Sheets(4).Copy
'Coller la feuille dans Word
    WdApp.Selection.Paste
'Annuler le mode couper/copier
    Application.CutCopyMode = False
    
   .SaveAs Filename:=Chemin
    .Close True
End With

WdApp.Quit
Set WdDoc = Nothing
Set WdApp = Nothing

ActiveSheet.Shapes("MonBouton2").Visible = True
Application.OnTime Now + TimeValue("00:00:02"), "EffacerMessage2"
End Sub
Sub EffacerMessage2()
ActiveSheet.Shapes("MonBouton2").Visible = False
End Sub

PHP:

Sub exportword()
Dim Tablo, Nom$, Chemin
Dim WdApp As Object, WdDoc As Object

On Error GoTo affichage

If Range("H5").Value <= 10 Then

'Nommer les cellules dans la feuille "Echéancier"
With Sheets("Echéancier")
    Tablo = .Range("A6:D10").Value
    Ref = .Range("B1")
    Nom = .Range("B2")
    Dates = .Range("B4")
    Adresse = .Range("B3")
    Dette = .Range("D1")
    Echéances = .Range("D2")
    Début_DP = .Range("D3")
End With

'Chemin d'enregistrement de l'engagement de paiement
Chemin = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & Ref & "\" & Nom & " Engagement de Paiement"

'Si les champs ne sont pas remplis affichier msgbox sinon éxécuter la suite
If Adresse = "" Or Nom = "" Or Ref = "" Or Dette = "" Or Dates = "" Or Echéances = "" Or Début_DP = "" Then
MsgBox "Veuillez compléter tous les champs avant de créer l'engagement de paiement.", vbOKOnly + vbCritical, "Attention"
Exit Sub
End If

'Déclaration de l'utilisation de Word
Set WdApp = CreateObject("Word.Application")
'Word visible
WdApp.Visible = True
'indiquer le chemin du fichier modèle
Set WdDoc = WdApp.Documents.Open(ThisWorkbook.Path & "\" & "Modele.doc")
'Dans le Doc Word
With WdDoc
    With .Tables(2)
        For I = 1 To UBound(Tablo, 1)
        On Error Resume Next
            .Columns(1).Cells(I + 1).Range.Text = CDate(Tablo(I, 1))
            .Columns(2).Cells(I + 1).Range.Text = FormatNumber(Tablo(I, 2), 2)
            .Columns(3).Cells(I + 1).Range.Text = CDate(Tablo(I, 3))
            .Columns(4).Cells(I + 1).Range.Text = FormatNumber(Tablo(I, 4), 2)
        Next
    End With
    'Signet dans Word
    .bookmarks("Nom").Range.Text = Nom
    .bookmarks("Dates").Range.Text = Dates
    .bookmarks("Ref").Range.Text = Ref
    .bookmarks("Adresse").Range.Text = Adresse
    .bookmarks("Dette").Range.Text = FormatNumber(Dette, 2)
    .SaveAs Filename:=Chemin, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    .Close True
End With

WdApp.Quit
Set WdDoc = Nothing
Set WdApp = Nothing

Else

With Sheets("Echéancier")
    date1 = .Range("A6").Value 'Date début échéancier
    montant1 = .Range("B6").Value 'Montant 1ere échéance
    zone = Range("D6:D30")
    date2 = .Range("G3").Value 'Avant dernière date de l'échéancier
    date3 = .Range("G2") 'Dernière date de l'échéancier
    montant2 = .Range("H2") 'Dernier montant de l'échéancier
    Ref = .Range("B1") 'numéro IGOR
    Nom = .Range("B2") 'Nom et Prénom
    Dates = .Range("B4") 'Période de la PDD
    Adresse = .Range("B3") 'Adresse du client
    Dette = .Range("D1") 'Montant de la dette
End With

Chemin = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & Ref & "\" & Nom & " Engagement de Paiement"

Set WdApp = CreateObject("Word.Application")
WdApp.Visible = True
Set WdDoc = WdApp.Documents.Open(ThisWorkbook.Path & "\" & "Modele.doc") 'indiquer le chemin du fichier modèle
With WdDoc
    With .Tables(2)
            .Columns(1).Cells(2).Range.Text = " du " & date1 & " au " & date2
            .Columns(2).Cells(2).Range.Text = FormatNumber(montant1, 2)
            .Columns(3).Cells(2).Range.Text = date3
            .Columns(4).Cells(2).Range.Text = FormatNumber(montant2, 2)
    End With
    .bookmarks("Nom").Range.Text = Nom
    .bookmarks("Dates").Range.Text = Dates
    .bookmarks("Ref").Range.Text = Ref
    .bookmarks("Adresse").Range.Text = Adresse
    .bookmarks("Dette").Range.Text = FormatNumber(Dette, 2)
    On Error Resume Next
    .SaveAs Filename:=Chemin, FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    'MsgBox "Erreur de dossier client"
    .Close True
End With

WdApp.Quit
Set WdDoc = Nothing
Set WdApp = Nothing
Application.StatusBar = "L'engagement de paiement de " & Nom & " a été créé."
Application.Wait (Now + TimeValue("00:00:02"))
Application.StatusBar = ""
Exit Sub
End If

ActiveSheet.Shapes("MonBouton3").Visible = True
Application.OnTime Now + TimeValue("00:00:02"), "EffacerMessage3"

affichage:
'ActiveSheet.Shapes("Label1").Visible = True
'Application.Wait (Now + TimeValue("00:00:04"))
'ActiveSheet.Shapes("Label1").Visible = False
MsgBox "Soit : " & vbCrLf & vbCrLf & "- Le dossier numérique de " & Nom & " n'a pas été créé. Dans ce cas, veuillez le créer puis générer l'engagement de paiement." & vbCrLf & vbCrLf & "- L'engagement de paiement de " & Nom & " a déjà été généré. Si vous souhaitez le modifier, veuillez le supprimer du dossier numérique puis recommencer.", vbCritical, "Attention"

End Sub
Sub EffacerMessage3()
ActiveSheet.Shapes("MonBouton3").Visible = False
End Sub

Pourrais tu m'aider ?

Merci

Effectuez une recherche sur Excel Downloads...

Vérifier si le dossier existe avant de le créer

matthieu2701

XLDnaute Occasionnel

Herdet

Nous a quitté

matthieu2701

XLDnaute Occasionnel

matthieu2701

XLDnaute Occasionnel

matthieu2701

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée