Lecture du dique pour savoir si un repertoire existe déjà

Signaler
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
-
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008
-
Slt,

Je cherche à faire une macro qui enregistre pour archive une copie de mon classeur dans un emplacement précis.
Cet emplacement sera : "D:\archive\archives_" & Year(Date)

Je veut donc utiliser le code suivant :

MkDir "D:\archive\archives_" & Year(Date)
ActiveWorkbook.SaveAs Filename:="D:\archive\archives_" & Year(Date) & "\Devis_" & Range("num_devis") & ".xls"

Cependant il manque quelque chose à ce code, il faut que j'éxecute le Mkdir uniquement si le repertoire ""archives_" & Year(Date)" n'existe pas déjà.

Je sollicite donc votre aide, pour trouver un code qui me permettrai de scanner le repertoire "D:\archive" afin de connaitre si il y existe déja un repertoire ""archives_" & Year(Date)".

Merci de votre aide.

olivier

12 réponses

Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
If Dir$("D:\archive\archives_" & Year(Date)) = "" Then

MkDir "D:\archive\archives_" & Year(Date)

End If

Daniel
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008

Merci, mais ton code ne fonctionne pas le test de la boucle est tjs égal a "" même quand le dossier "archives_" & Year(Date)
est existant. Je fait donc le mkdir a chaque fois ce qui n'est pas bon.
Tu vois l'erreur ?
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
oui, je vois, il faut rajouter une barre sinon il le prend comme fichier:

If Dir$("D:\archive\archives_" & Year(Date) & "") = "" then

Daniel
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008

Ok merci ca marche, je suis bête sje le savait en plus.

En attendant ta réponse j'ai réussi a partir de données piqué a doite et a gauche a écrire un code plus compliqqué qui fonctionne aussi :

Dim tablo(50) As String
Dim x As Integer

chemin = "D:\archive"
recherche = Dir$(chemin & "*.*", vbDirectory)
x = 0
Do While recherche <> ""
If (recherche <> "." And recherche <> "..") Then
If (GetAttr(chemin & recherche) And vbDirectory) Then
x = x + 1
nom_dossier = recherche
tablo(x) = nom_dossier
End If
End If
recherche = Dir$()
DoEvents
Loop


For y = 1 To x
If tablo(x) = "archives_" & Year(Date) Then
GoTo suite
End If
Next y



MkDir "D:\archive\archives_" & Year(Date)
ActiveWorkbook.SaveAs Filename:="D:\archive\archives_" & Year(Date) & "\Devis_" & Range("num_devis") & ".xls"
Exit Sub


suite:
ActiveWorkbook.SaveAs Filename:="D:\archive\archives_" & Year(Date) & "\Devis_" & Range("num_devis") & ".xls"

Vois tu un interet a mon code par rapport au tien?
Si non j'utiliserai le tiens car il est beaucoup plus simple.

Merci

Olivier
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
c'est très utile pour aller chercher tous les sous-répertoires d'un répertoire, ils sont mis dans une table et ensuite tu peux les utiliser comme tu veux.
les 2 font la même chose puis qu'ensuite il cherche dans la table si ton répertoire existe.
mais bon si t'as besoin des autres répertoires c'est utile mais pour vérifier un seul répertoire un seul Dir suffit.

Daniel
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008

Ok merci, c'est ce que je penser, donc mon code est a garder précieusement, mais dans mon appli ton code est emplement suffisant.

Encore merci rt bonne nuit
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008

Slt ton code présente quand mêm un problème, le dire plante lorsque le repertoire archives_" & Year(Date).
Il vérifie bien si le dossier existe et le cré si non, mais ne gere pas le cas ou il esicte mais est vide.

Je reviens donc sur mon code auquel j'ai ajouté la gestion des erreurs lorsque le fichier existe et que l'on choisi d ne pas l'ecraser :

Private Sub cmd_archive_Click()


Dim chemin_appli, chemin, chemin2 As String
Dim nom_dossier, nom_dossier2 As String
Dim recherche, recherche2 As String
Dim x, x2, y, y2 As Integer
Dim tablo(100), tablo2(100) As String
Dim erreur1, erreur2, error1, error2 As Boolean

'Verifie si un numéro de devis est bien entré
If Worksheets("devis").range("num_devis") = "" Then
MsgBox "Veuillez d'abord entrer un numéro de devis pour ce chiffrage.", vbExclamation
Exit Sub
End If

erreur1 = False
erreur2 = False
error1 = False
error2 = False

Application.ScreenUpdating = False

' Archive le devis en local sur D:\archive
On Error GoTo fin
error1 = True
chemin = "D:\archive"
recherche = Dir$(chemin & "*.*", vbDirectory)
x = 0
Do While recherche <> ""
If (recherche <> "." And recherche <> "..") Then
If (GetAttr(chemin & recherche) And vbDirectory) Then
x = x + 1
nom_dossier = recherche
tablo(x) = nom_dossier
End If
End If
recherche = Dir$()
DoEvents
Loop
For y = 1 To x
If tablo(y) = "archives_" & Year(Date) Then
GoTo save
End If
Next y

MkDir "D:\archive\archives_" & Year(Date)
ActiveWorkbook.SaveAs Filename:=chemin & "archives_" & Year(Date) & "" & range("num_devis") & ".xls"
GoTo suite

save:
ActiveWorkbook.SaveAs Filename:=chemin & "archives_" & Year(Date) & "" & range("num_devis") & ".xls"



suite:
' Archive le devis sur le reseau à l'emplacement S:\tcr\Devis Circuit Long\
error2 = True
chemin2 = "X:\tcr\Devis Circuit Long"
recherche2 = Dir$(chemin2 & "*.*", vbDirectory)
x2 = 0
Do While recherche2 <> ""
If (recherche2 <> "." And recherche2 <> "..") Then
If (GetAttr(chemin2 & recherche2) And vbDirectory) Then
x2 = x2 + 1
nom_dossier2 = recherche2
tablo2(x2) = nom_dossier2
End If
End If
recherche2 = Dir$()
DoEvents
Loop
For y2 = 1 To x2
If tablo2(y2) = "archives_" & Year(Date) Then
GoTo save2
End If
Next y2

MkDir "X:\tcr\Devis Circuit Long\archives_" & Year(Date)
ActiveWorkbook.SaveAs Filename:=chemin2 & "archives_" & Year(Date) & "" & range("num_devis") & ".xls"

Application.ScreenUpdating = True
If erreur1 = True Then
MsgBox "Attention !" & vbNewLine & "Le fichier '" & range("num_devis") & ".xls" & "' n'a était enregistré que sur le disque réseau S."
Else
MsgBox "Félicitation !" & vbNewLine & "Le fichier '" & range("num_devis") & ".xls" & "' a bien était enregistré sur les disque D et S."
End If


Application.DisplayAlerts = False
Workbooks(range("num_devis") & ".xls").Close
Application.DisplayAlerts = True
Exit Sub

save2:
ActiveWorkbook.SaveAs Filename:=chemin2 & "archives_" & Year(Date) & "" & range("num_devis") & ".xls"

Application.ScreenUpdating = True
If erreur1 = True Then
MsgBox "Attention !" & vbNewLine & "Le fichier '" & range("num_devis") & ".xls" & "' n'a était enregistré que sur le disque réseau S."
Else
MsgBox "Félicitation !" & vbNewLine & "Le fichier '" & range("num_devis") & ".xls" & "' a bien était enregistré sur les disques D et S."
End If

Application.DisplayAlerts = False
Workbooks(range("num_devis") & ".xls").Close
Application.DisplayAlerts = True
Exit Sub

fin: If error1 True And error2 False Then
erreur1 = True
GoTo suite
Else
Application.ScreenUpdating = True
erreur2 = True If erreur1 True And erreur2 True Then
MsgBox "Attention !" & vbNewLine & "Le fichier '" & range("num_devis") & ".xls" & "' n'a était enregistré sur aucun disque."
ElseIf erreur2 = True Then
MsgBox "Attention !" & vbNewLine & "Le fichier '" & range("num_devis") & ".xls" & "' n'a était enregistré que sur le disque local D."
End If

Application.DisplayAlerts = False
Workbooks(range("num_devis") & ".xls").Close
Application.DisplayAlerts = True
End If


End Sub

Mais il y a tout de même un problème, dans le cas ou les fichiers dans les 2 emplacements (disque d et x) existent dejà et que excel demande si on veut les ecraser ou non, si je choisi 2 fois non (donc je doit normalement aller 2 fois dans l'etiquette "fin:" grace au on error goto fin), excel plante au 2ème non.
Apparement il ne supporte pas de rentrer 2 fois dans la routine on error.

Une idée ???

Merci

Olivier
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
pour le code qui marche pas quand il y a pas de fichier c'est vrai.
mais on peut modifier et chercher les répertoires, il y a toujours le "." et ".." qui existent (sauf sur la racine mais c'est pas le cas ici)

If Dir$("D:\archive\archives_" & Year(Date) & "",vbDirectory) = "" then ...

pour l'erreur (j'ai pas bien vu pourquoi il va en erreur) tu supprimes l'erreur précédente avec Resume suite au lieu de GoTo suite

Daniel
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008

- ok pour le :
If Dir$("D:\archive\archives_" & Year(Date) & ""
,vbDirectory) = "" then ...

- Tu dit qu etu comprend pas pourquoi il va en erreur:
En faite quand dans une macro on utilise un saveas et que excel utilise la fonction qui préviens si l'on veut ou non ecraser un fichier car celui-ci existe deja, si on repond non il s'arrete a l'instruction save as et plante. c'est pour cela que j'ai mi un on error go to pour enrienter moncode et éviter ce plantage

- Par contre je comprend pas l'hisoire du resume a la place du goto:
si je met "on error resume fin", ca marche pas l'instruction n'est pas reconnue. Faut faire koi?
Moi je connaissais le resume uniquement pour faire du resume next et passer a l'instruction suivant celle qui plante

olivier
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
pour l'erreur je te fait confiance puisque je connais rien à excel,
mais on va se comprendre quand même.

donc je résume (c'est le cas de le dire) :
faut laisser le on error Goto fin et c'est dans fin: donc en cours de l'erreur qu'il faut mettre le Resume suite
le Resume remplace le GoTo en supprimant l'erreur.

Daniel
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008

Ok parfait, merci je t'avais mal lu.

Il me reste plus qu'a utiliser mes boucle fin et suite avec ton code au lieu du mien puisque maintenant le tien n'a plus le pb du dossier vide.

Encore merci
Messages postés
188
Date d'inscription
mardi 21 décembre 2004
Statut
Membre
Dernière intervention
10 avril 2008

Voila ca donne ca :

Private Sub cmd_archive_Click()


Dim chemin, chemin2 As String
Dim erreur1, erreur2, error1, error2 As Boolean

'Verifie si un numéro de devis est bien entré
If Worksheets("devis").Range("num_devis") = "" Then
MsgBox "Veuillez d'abord entrer un numéro de devis pour ce chiffrage.", vbExclamation
Exit Sub
End If
chemin = "D:\archive"
chemin2 = "C:\tcr\Devis Circuit Long"
erreur1 = False
erreur2 = False
error1 = False
error2 = False


Application.ScreenUpdating = False


' Archive le devis en local sur D:\archive
On Error GoTo fin
error1 = True
If Dir$("D:\archive\archives_" & Year(Date) & "", vbDirectory) = "" Then
MkDir "D:\archive\archives_" & Year(Date)
End If
ActiveWorkbook.SaveAs Filename:=chemin & "archives_" & Year(Date) & "" & Range("num_devis") & ".xls"

suite:
error2 = True
If Dir$("C:\tcr\Devis Circuit Long\archives_" & Year(Date) & "", vbDirectory) = "" Then
MkDir "C:\tcr\Devis Circuit Long\archives_" & Year(Date)
End If
ActiveWorkbook.SaveAs Filename:=chemin2 & "archives_" & Year(Date) & "" & Range("num_devis") & ".xls"

Application.ScreenUpdating = True
If erreur1 = True Then
MsgBox "Attention !" & vbNewLine & "Le fichier '" & Range("num_devis") & ".xls" & "' n'a était enregistré que sur le disque réseau S."
Else
MsgBox "Félicitation !" & vbNewLine & "Le fichier '" & Range("num_devis") & ".xls" & "' a bien était enregistré sur les disques D et S."
End If


Application.DisplayAlerts = False
Workbooks(Range("num_devis") & ".xls").Close
Application.DisplayAlerts = True
Exit Sub


fin:
If error1 True And error2 False Then
erreur1 = True
Resume suite
Else
Application.ScreenUpdating = True
erreur2 = True If erreur1 True And erreur2 True Then
MsgBox "Attention !" & vbNewLine & "Le fichier '" & Range("num_devis") & ".xls" & "' n'a était enregistré sur aucun disque."
ElseIf erreur2 = True Then
MsgBox "Attention !" & vbNewLine & "Le fichier '" & Range("num_devis") & ".xls" & "' n'a était enregistré que sur le disque local D."
Application.DisplayAlerts = False
Workbooks(Range("num_devis") & ".xls").Close
Application.DisplayAlerts = True
End If


End If
End Sub

C'est quand même mieux et plus court comme ca.