Suppression d'un fichier en VBA

Bonjour à tous,

je souhaite mettre en place une macro qui supprime le fichier après une date.

J'ai trouvé une macro en fouillant sur le net ;), mais je l'ai testé et après la date fatidique.. j'ai un message d'erreur.

_________________________________________________________________________________________________________________________________________________________________

Private Sub Workbook_Open()
If Now() > #11/4/2013# Then
MsgBox "Attention la date d'expiration est arrivée." & _
" Ce fichier sera détruit dans 3 secondes. Merci."
Sleep (3000)
Call Module1.Suicide
End If
End Sub

_________________________________________________________________________________________________________________________________________________________________

Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles.Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub

Pouvez vous me dire ce qui cloche.. ou auriez vous une autre solution ?

Merci de votre aide :)

Bonjour,

je ne l'ai pas tester, mais cette ligne me donne des mauvaise idées.

For Ndx = 1 To Application.RecentFiles.Count

je préfères

For Ndx = Application.RecentFiles.Count to 1 step -1

. j'ai un message d'erreur.

c'était quoi ?

Bonjour BsAlv,

"erreur de compilation dans le mode caché : thisworkbook

Cette erreur survient généralement lorsque le code est incompatible avec la version..."

et quand je passe par le débogage il s'arrete sur la fonction sleep " Erreur de compilation: Sub ou fonction non définie"

merci de ton aide

__________________________________________________________________________________________________________________________________________________________________

sinon j'ai teste celui ci dessous et j'ai mis en pièce jointe le message d'erreur avec le débogage :)

________________________________________________________________________________________________________________________________________________________________

Private Sub Workbook_Open()

Application.ScreenUpdating = False 'l'utilisateur ne voit pas les changement sur son écran

'la date d'expiration
DateExpiration = DateSerial(2021, 12, 31) ' <= choisissez la date d'expiration >>> via la fonction DateSerial avec les paramètres (aaaa, mm, jj)

'compare la date d'expiration avec la date d'aujourd'hui
If DateExpiration <= Date Then
'le code de l'action à effectuer quand le fichier est expiré
'par exemple un message:
MsgBox "Ce fichier n'est plus valide..."
Else
End If

Application.ScreenUpdating = True 'on réenclenche l'affichage des changements

End Sub

________________________________________________________________________________________________________________________________________________________________

Bonjour,

Sub KillMe()
  With ThisWorkbook
    If Len(Dir(.FullName)) Then
      .Saved = True
      On Error Resume Next
      .ChangeFileAccess Mode:=xlReadOnly
      On Error GoTo 0
      SetAttr Pathname:=.FullName, Attributes:=vbNormal
      Kill .FullName
      .Close SaveChanges:=False
    End If
  End With
End Sub

Merci BsAlv,

concernant la condition ?

je mets ton code après ma partie: If DateExpiration <= Date Then ???

merci de ton aide :)

Bonjour,

correct, cela a reussi ?

Bonjour à tous,

ça ne marche pas :(.... sais tu ou j'ai fait une erreur ??

c'est la partie qui est en jaune qui bloque

Merci de votre aide et bonne journée

Bonjour Jean_talus
Tout comme pour l'ami BsAlv à qui j'ai indiqué la chose

Et comme je suis très à cheval sur la politesse, merci de respecter la charte du forum [A LIRE AVANT DE POSTER]

• Un minimum de politesse est de rigueur (bonjour, SVP, merci, ...), sans cela vous aurez peu de chance d'obtenir une réponse et vous risquez de voir votre message supprimé par un modérateur.

Les discussions de type "tchat" ne seront pas admises

Merci d'éditer votre dernier message et d'y mettre le mot de politesse SVP

A+

Bonjour BsAlv,

cela ne fonctionne pas... si je le colle avec mon code du premier message, ça bloque sur Sleep :(...

une idée pour peut être modifié la partie de condition ??

merci à tous

Bonsoir jean_talus

Je vous invite à relire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum et notamment

• Joignez (si possible) un fichier pour augmenter vos chances d'obtenir de l'aide en cliquant sur le bouton Fichier de l'éditeur. Si votre fichier est trop lourd ou contient des données personnelles, créez une version allégée de votre fichier avec juste assez d'informations pour permettre de comprendre votre problème. Dans tous les cas, ne postez JAMAIS de fichiers avec des informations personnelles ou confidentielles (cet utilitaire peut vous aider à les retirer).

"Sleep" n'est pas une fonction intégrée à VBA, il faut la déclarer...

Donc afin d'éviter de parler dans le vide

bonsoir,

.fullname cause un erreur que je suis pas capable à visualiser.

Ou est-ce que vous sauvegardé ce fichier ? Sur un server ?

C'est quoi le résultat de la nouvelle ligne rouge ? (subdirectory actuale et name+path de votre fichier)

Y-a-t-il des charactères interdites dedans ?

Sub KillMe()

With ThisWorkbook

MsgBox CurDir & vbLf & .FullName

If Len(Dir(.FullName)) Then

....

Bonjour à tous,

ci dessous l'erreur quand le lance mon fichier. la condition fonctionne, mais la partie qui devrait lancer la suppression du fichier plante....

fichier joint .

le fichier ne sera pas sur un serveur. :)

Bonne soirée et merci de votre aide

Re,

Normal

La sub "KillMe" doit être mise dans un module1 et non dans le code de la feuille

A+

bonsoir,

la ligne call module1.killme cause des problemes, killme est déjà dans la module1, la même module "thisworkbook", donc killme suffit.

Quand je fais cela, je l'ai sauvergardé, fermée et au moment ou je l'ouvre, je reçois le message "...expiration ..." et le file est "killed".

No erreurs ??? !!!

Bonsoir,

j'ai déplacé Killme dans le module1... ça ne change rien... toujours un bug :(

cela pourrait venir de ma version de excel ?

Re,

Vous êtes bien sur PC ?

Si oui, allez voir

A+

Bonsoir, Bruno ce n'était pas coché

j'ai coché mais cela ne change rien...

et plus bizarre encore j'ai envoyé mon fichier à mes fils.. qui sont sur Excel365.. et ça marche...

le débogueur s'arrete à chaque fois sur Kill :(....

re,

quelques adaptions qui y sont pour essayer à chercher la cause.

Sub KillMe()
     With ThisWorkbook
          MsgBox VarType(.FullName)
          MsgBox .FullName
          MsgBox VarType(Dir(.FullName))
          MsgBox Dir(.FullName)
          If Len(CStr(Dir(.FullName))) Then
               .Saved = True
               On Error Resume Next
               .ChangeFileAccess Mode:=xlReadOnly
               On Error GoTo 0
               SetAttr Pathname:=.FullName, Attributes:=vbNormal
               Kill CStr(.FullName)
               .Close SaveChanges:=False
          End If
     End With
End Sub

Avez-vous "option explicit" as premiere ligne de la module ?

Bonjour à tous,

Merci BsAlv, votre code fonctionne parfaitement. et merci Bruno en plus de cocher dans les options j'ai redémarré le PC. et hop ça marche !!!!

Bonne journée à tous

bonjour,

un des "settings" n'était pas bon, n'est-ce pas ? Lequel ?

C'est bizar que la moitié du programma est parcouru ...