Lecture du dique pour savoir si un repertoire existe déjà
olivier857
Messages postés188Date d'inscriptionmardi 21 décembre 2004StatutMembreDernière intervention10 avril 2008
-
18 avril 2005 à 23:22
olivier857
Messages postés188Date d'inscriptionmardi 21 décembre 2004StatutMembreDernière intervention10 avril 2008
-
20 avril 2005 à 00:55
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)
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
A voir également:
Lecture du dique pour savoir si un repertoire existe déjà
olivier857
Messages postés188Date d'inscriptionmardi 21 décembre 2004StatutMembreDernière intervention10 avril 2008 19 avril 2005 à 00:46
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 ?
olivier857
Messages postés188Date d'inscriptionmardi 21 décembre 2004StatutMembreDernière intervention10 avril 2008 19 avril 2005 à 01:03
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
Gobillot
Messages postés3140Date d'inscriptionvendredi 14 mai 2004StatutMembreDernière intervention11 mars 201934 19 avril 2005 à 01:11
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.
olivier857
Messages postés188Date d'inscriptionmardi 21 décembre 2004StatutMembreDernière intervention10 avril 2008 19 avril 2005 à 22:47
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
' 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
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
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.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
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.
Gobillot
Messages postés3140Date d'inscriptionvendredi 14 mai 2004StatutMembreDernière intervention11 mars 201934 19 avril 2005 à 23:21
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
olivier857
Messages postés188Date d'inscriptionmardi 21 décembre 2004StatutMembreDernière intervention10 avril 2008 20 avril 2005 à 00:07
- 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
Gobillot
Messages postés3140Date d'inscriptionvendredi 14 mai 2004StatutMembreDernière intervention11 mars 201934 20 avril 2005 à 00:17
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.
olivier857
Messages postés188Date d'inscriptionmardi 21 décembre 2004StatutMembreDernière intervention10 avril 2008 20 avril 2005 à 00:55
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
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