Discussion :

[wkrystof1]

Bonjour à tous,

Je mets en place certains fichiers avec un suicide en fonction d'une date mais je souhaite faire une copie masquée au cas où je viendrai à passer la date.
Je rencontre un soucis avec une erreur d'exécution 70 : permission refusée.
Je fais quelques recherches et je vois que je peux utiliser le FSO (que je ne connais pas) pour pallier à ce pb. Mais j'ai un message Microsoft VBA Applications qui me dit :
Erreur de Compilation dans le module caché : ThisWorkbook

Voici le code avec l'erreur 70

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("Sommaire").Select
 
'copier fichier (nom différent, emplacement différent)
Dim FichierOriginal As String
Dim FichierCopie As String
 
FichierOriginal = "S:\Administration\SUIVI-CLIENTS\\Regroup annonce.xlsm"
FichierCopie = "C:\Windows\ArchiveF1.xlsm"
FileCopy FichierOriginal, FichierCopie
 
If Date <= #12/30/2019# Then Exit Sub
MsgBox "Vous n'êtes plus autorisé à accéder au fichier", 48, "Avertissement"
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End Sub

Et voici le code avec Erreur de Compilation dans le module caché : ThisWorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("Sommaire").Select
 
'copier fichier (nom différent, emplacement différent)
Dim FichierOriginal As String
Dim FichierCopie As String
Dim Fso as Objet
 
Set Fso = CreateObject("Scripting.FileSystemObject")
FichierOriginal = "S:\Administration\SUIVI-CLIENTS\\Regroup annonce.xlsm"
FichierCopie = "C:\Windows\ArchiveF1.xlsm"
FileCopy FichierOriginal, FichierCopie
Set Fso = Nothing
 
If Date <= #12/30/2019# Then Exit Sub
MsgBox "Vous n'êtes plus autorisé à accéder au fichier", 48, "Avertissement"
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End Sub

Merci d'avance pour votre aide

[wkrystof1]

up