Suppression fichiers Excel sous conditions

[Christounet]

Je voudrais supprimer des fichiers sous conditions de l'incrémentation de la date dans le nom des fichiers dans un répertoire donné.

Exemple j'utilise une macro nommant les fichiers :

Code : Worksheets(1).SaveAs "W:\A Essais\Macros" & " - " & format$(now,"yyyy mm dd hh\hnn ss") & ".xls"

les fichiers sont dont incréméntés à la fermeture sous le nom de fichier :
Macros - 2011 02 05 - 23h09 34.xls
Macros - 2011 02 05 - 23h10 00.xls
Macros - 2011 02 06 - 23h06 05.xls
Macros - 2011 02 06 - 23h06 33.xls

Ce que je recherche donc : une macro qui à la fermeture du fichier exécutera la suppression des fichiers antérieurs à la dernière date moins 1 jour.
Donc supression des 2 fichiers daté du 2011 02 05

Merci de votre collaboration
Christounet

 

[kjin]

Re : Suppression fichiers Excel sous conditions

Bonsoir,
Attention : supprime tous les fichiers du répertoire spécifié dont la date de modif est inférieure à J-1; c'est sans retour

Sub d()
Dim fs, fl, f
pDossier = "W:\A Essais\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set fl = fs.getfolder(pDossier).Files
    For Each f In fl
        If f.DateLastModified < VBA.Date - 1 Then Kill f
    Next
End Sub

A+
kjin

 

[Staple1600]

Re : Suppression fichiers Excel sous conditions

Bonjour à tous, sieur kjin mes salutations du matin

Pour une méthode moins "tarantinoiesque", voici un exemple qui envoie le fichier à la poubelle

Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
sFrom As String
sTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40

Sub DeleteFileUsingAPI()
Dim oFilAPI As SHFILEOPSTRUCT
Dim lReturn As Long
Dim sFile As String ' File that needs to be deleted
sFile = "C:\ Temp\test.xls"

With oFilAPI
.wFunc = FO_DELETE
.sFrom = sFile
.sTo = vbNullChar
.fFlags = FOF_SILENT + FOF_NOCONFIRMATION + FOF_ALLOWUNDO
End With

' Use WinAPI User Defined Function
lReturn = SHFileOperation(oFilAPI)
Err_Delete:
MsgBox(Err.Number & " - " & Err.Description)
Err.Clear()
Resume Next
End Sub
'auteur : Devakottai PaneerSelvam

 

[Christounet]

Re : Suppression fichiers Excel sous conditions

Bonjour à tous, sieur kjin mes salutations du matin

Pour une méthode moins "tarantinoiesque", voici un exemple qui envoie le fichier à la poubelle

Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
sFrom As String
sTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40

Sub DeleteFileUsingAPI()
Dim oFilAPI As SHFILEOPSTRUCT
Dim lReturn As Long
Dim sFile As String ' File that needs to be deleted
sFile = "C:\ Temp\test.xls"

With oFilAPI
.wFunc = FO_DELETE
.sFrom = sFile
.sTo = vbNullChar
.fFlags = FOF_SILENT + FOF_NOCONFIRMATION + FOF_ALLOWUNDO
End With

' Use WinAPI User Defined Function
lReturn = SHFileOperation(oFilAPI)
Err_Delete:
MsgBox(Err.Number & " - " & Err.Description)
Err.Clear()
Resume Next
End Sub
'auteur : Devakottai PaneerSelvam

Bonsoir,
Merci de votre réponse, je rencontre en lançant ce code un message:
Erreur de complilation : Erreur de syntaxe
Et dans le code Err.clear() est en surbrillance.
Christounet

 

[Christounet]

Re : Suppression fichiers Excel sous conditions

Merci, de votre réponse.
Code efficace, rapide, mais je recherche la suppression uniquement des fichiers qui comporte le même nom racine, dans l'exemple Macros XXXXXXXXXX.xls.
Christounet

 

[Christounet]

Re : Suppression fichiers Excel sous conditions

Bonsoir,
Attention : supprime tous les fichiers du répertoire spécifié dont la date de modif est inférieure à J-1; c'est sans retour

Sub d()
Dim fs, fl, f
pDossier = "W:\A Essais\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set fl = fs.getfolder(pDossier).Files
    For Each f In fl
        If f.DateLastModified < VBA.Date - 1 Then Kill f
    Next
End Sub

A+
kjin

Merci, de votre réponse.
Code efficace, rapide, mais je recherche la suppression uniquement des fichiers qui comporte le même nom racine, dans l'exemple Macros XXXXXXXXXX.xls.
Christounet

 

[kjin]

Re : Suppression fichiers Excel sous conditions

Bonsoir,

Sub d()
Dim fs, fl, f
pDossier = "W:\A Essais\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set fl = fs.getfolder(pDossier).Files
    For Each f In fl
        If f.Name Like "Macros*" Then
            If f.DateLastModified < VBA.Date - 1 Then Kill f
        End If
    Next
End Sub

A+
kjin