Problème Kill fichier dans TEMP

Version imprimable

Voir 40 message(s) de cette discussion en une page

29/09/2008, 11h22
fthem

ça marche, je slectionne mon Url et je la supprime bien
mais pour adapter le code à un seul bouton (sans passer par un userform)qui quand tu clic va sélectionner "http://acrnmp.kwe.egs.edf.fr/ACRBO5/Gda.php" et le supprimer directement , je rame un peu:roll:
29/09/2008, 19h01
Montor

Oui ces fichiers ne sont pas completement supprimés pour cela ce fichier supprime vos fichiers
acrboimport[1].xls
acrboimport[2].xls
acrboimport[3].xls
tester le ca marche pour moi pour avoir une liste de plusieurs fichier acrboimport.xls indexés ouvrez plusieurs fenetres ie
pour les fichiers csv ne utiliser pas les fichies php que j'ai envoyes ils ne sont pas sur et rediges a la hate c'est une simple demonstation pour te montrer comment ça marche
ces fichiers n'ont pas une protection contre certaines cacacteres et le fichier est a chaque fois ecrit et ecrit penser si sa taille est grande !!
30/09/2008, 08h51
fthem

:yaisse2:
ça a l'air de bien fonctionner
par contre le raccourci reste ça ne gène en rien???????

aïe :?j'ai parlé trops vite,
j'ai une erreur 91 et il bloque à cette ligne

Code:

Set dossier = doss.getfolder(inp)

?????
30/09/2008, 09h28
ced600

Citation:

Envoyé par fthem

:yaisse2:
ça a l'air de bien fonctionner
par contre le raccourci reste ça ne gène en rien???????

Enfin !!!!
:lahola:
30/09/2008, 09h36
Godzestla

Citation:

Envoyé par ced600

Enfin !!!!
:lahola:

C'était sans compter sur le mauvais sort qui vient de s'acharner à nouveau...:aie:

Je ne comprends pas bien lorsque je crée un module dans mon fichier et que j'y colle le code en entier activé par un bouton ca marche
et lorsque j'inclue cette partie sous un bouton déja existant
exemple:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub importage_Click()
 
val21 = Workbooks("acrboimport[1].xls").Worksheets("FDMexport").Range("N5").Value
val22 = Workbooks("acrboimport[1].xls").Worksheets("FDMexport").Range("O5").Value
val23 = Workbooks("acrboimport[1].xls").Worksheets("FDMexport").Range("B2").Value
 
Workbooks("FCMO1.xls").Worksheets("FDM").Cells.Replace What:="LLLL", Replacement:=val21, LookAt:=xlPart
Workbooks("FCMO1.xls").Worksheets("FDM").Cells.Replace What:="MMMM", Replacement:=val22, LookAt:=xlPart
Workbooks("FCMO1.xls").Worksheets("FDM").Cells.Replace What:="NXNX", Replacement:=val23, LookAt:=xlPart
 
 
Windows("acrboimport[1].xls").Activate
    ActiveWindow.Close
 
  Dim obj As Object
Dim fichier As String
Dim Sp() As String
Set obj = CreateObject("WScript.Shell")
Set doss = CreateObject("scripting.filesystemobject")
Sp = Split(obj.SpecialFolders(16), "\", 4)
Sp(3) = "Local Settings\Temporary Internet Files"
fichier = "acrboimport*.xls"
 'acrboimport*.xls  nom de vos fichiers tu peux mettre fichier ="*.xl*"pour supprimer
 'tout les fichier excel 2003 et 2007
Call chemin(Join(Sp, "\"), fichier)
'MsgBox "Recherche terminée"
 
importage.Visible = False
 
End Sub

et que je place cette partie dans un nouveau module:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Private doss As Object
Sub chemin(inp, str)
    Dim dossier, elem As Variant
    Set dossier = doss.getfolder(inp)
     On Error Resume Next
     doss.deletefile inp & "\" & str, True
     Err.Clear
     For Each elem In dossier.subfolders
    chemin elem.Path, str
    Next
End Sub

lorsque j'active la macro, il me dit :
erreur d'execution"91"
Variable objet ou variable de bloc With non définie en s'arretant sur la ligne :
Set dossier = doss.getfolder(inp)

30/09/2008, 11h31
Godzestla
Tu ne crois pas que ceci (au moins......) pose problème :
Code:

1 2 Private doss As Object
:bug: :aie:
30/09/2008, 11h49
fthem

pourquoi cela gènerait-il ?? sachant que lorsque je met tout le code dans le même module activé par unbouton cela fonctione...
30/09/2008, 12h09
Godzestla

Citation:

Envoyé par fthem

pourquoi cela gènerait-il ?? sachant que lorsque je met tout le code dans le même module activé par unbouton cela fonctione...

Tu réponds toi-même à la question ... :bug:
30/09/2008, 13h17
fthem

oui, mais si je met tout le code dans un même modile existant il me met cette fameuse erreur

bonjour
essaie

Code:

public doss As Object

Bonjour
Une petite précision sur les codes
Pour le fichier qui supprime le cache il fonctionne bien et supprime le fichier acrboimport[*]et ses informations qui est dans le cache mais si par ex tu ouvre le fichier pour une deuxième fois et le fichier est déjà ouvert tu auras deux fichier acrboimport[*] soit acrboimport[1] et acrboimport[2] dans un même dossier dans "Content.IE5" soit deux de acrboimport[1] dans dossiers différent touts ces fichiers sont sous une seule icône et un seul nom "acrboimport.xls" dans le cache qui apparaît dans le dossier "Temporary Internet Files" lorsque tu supprime le cache un seul sera supprimer
Pour le deuxième fichier il explore le dossier Temporary Internet Files et supprime ces fichiers la c'est beaucoup plus garanti
lorsque tu supprime les fichiers excel if faut pas se laisser arnaquer par cet icône qui est dans le cache est apparaît dans le dossier Temporary Internet
il n est pas important pour la supprimer car le fichier associe est supprimé
Voici la combinaison de ces deux codes (supprimer entièrement le code du fichier delete.xls et mets ceci)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 Option Explicit Private doss As Object Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _ Alias "DeleteUrlCacheEntryA" _ (ByVal lpszUrlName As String) As Long Sub chemin(inp, str) Dim dossier, elem As Variant Set dossier = doss.getfolder(inp) On Error Resume Next doss.deletefile inp & "\" & str, True Err.Clear For Each elem In dossier.subfolders chemin elem.Path, str Next End Sub Private Sub CommandButton1_Click() Dim obj As Object Dim fichier As String Dim Sp() As String Set obj = CreateObject("WScript.Shell") Set doss = CreateObject("scripting.filesystemobject") Sp = Split(obj.SpecialFolders(16), "\", 4) Sp(3) = "Local Settings\Temporary Internet Files" Call DeleteUrlCacheEntry("http://acrnmp.kwe.egs.edf.fr/ACRBO5/Gda.php?") ''http://localhost/ entrer le domaine fichier = "acrboimport*.xls" 'acrboimport*.xls nom de vos fichiers tu peux mettre fichier ="*.xl*"pour supprimer 'tout les fichier excel 2003 et 2007 Call chemin(Join(Sp, "\"), fichier) MsgBox "Recherche terminée" End Sub
si tu veux empeche le windows de mettre ce fichier dans le cache chercher et changer ce code php
Code:

1 2 3 4 5 6 7 8 9 function send($filename='fichier.xls') { header("Content-type: application/vnd.ms-excel"); header("Content-Disposition: attachment; filename=\"$filename\""); header("Expires: 0"); header("Cache-Control: must-revalidate, post-check=0,pre-check=0"); header("Pragma: public"); }
vers
Code:

1 2 3 4 5 6 7 8 9 function send($filename='fichier.xls') { header("Content-type: application/vnd.ms-excel"); header("Content-Disposition: attachment; filename=\"$filename\""); header("Expires: 0"); header("Cache-Control: no-cache, must-revalidate"); readfile($filename);//pour recevoir le contenu du fichier }

deplacer ces deux lignes vers la fonction chemin

Code:

1
2
 
Set doss = CreateObject("scripting.filesystemobject")

Code:

1
2
 
 Private doss As Object

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub chemin(inp, str)
    Dim doss As Object
    Set doss = CreateObject("scripting.filesystemobject")
    Dim dossier, elem As Variant
    Set dossier = doss.getfolder(inp)
     On Error Resume Next
     doss.deletefile inp & "\" & str, True
     Err.Clear
     For Each elem In dossier.subfolders
    chemin elem.Path, str
    Next
End Sub

salut,
dans un module séparé j'ai mis ça:
Code:

1 2 3 4 5 Option Explicit Public doss As Object Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _ Alias "DeleteUrlCacheEntryA" _ (ByVal lpszUrlName As String) As Long
pour la fonction chemin j'ai mis ça:
Code:

1 2 3 4 5 6 7 8 9 10 Sub chemin(inp, str) Dim dossier, elem As Variant Set dossier = doss.getfolder(inp) On Error Resume Next doss.deletefile inp & "\" & str, True Err.Clear For Each elem In dossier.subfolders chemin elem.Path, str Next End Sub
sous le bouton, j'ai mis ça:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim obj As Object Dim fichier As String Dim Sp() As String Set obj = CreateObject("WScript.Shell") Set doss = CreateObject("scripting.filesystemobject") Sp = Split(obj.SpecialFolders(16), "\", 4) Sp(3) = "Local Settings\Temporary Internet Files" 'Call DeleteUrlCacheEntry("http://acrnmp.kwe.egs.edf.fr/ACRBO5/Gda.php?") ''http://localhost/ entrer le domaine fichier = "acrboimport*.xls" Call chemin(Join(Sp, "\"), fichier)
pour l instant, j'ai mis cette ligne en commentaire pour tester juste l'effacement du fichier acrboimport.xls

Code:

'Call DeleteUrlCacheEntry("http://acrnmp.kwe.egs.edf.fr/ACRBO5/Gda.php?")

bon ça fonctionne sur certains postes, mais sur un poste,cela me met

Citation:

erreur d'excecution '9'
l'indice n'appartient pas à la sélection

et le débogage s'arrète sur:

Code:

Sp(3) = "Local Settings\Temporary Internet Files"

et sur un autre

Citation:

erreur d'excecution '76'
chemin introuvable

et le débogage s'arrète sur:

Code:

Set dossier = doss.getfolder(inp)

??????????

Bonjour

Citation:

erreur d'excecution '76'
chemin introuvable

tu n'es pas sous WinXp peut etre
c'est ca ne marche pas tu doit entrer le chemin de dossier internet tmp manualement dans le variable
dossier =""pour ces postes et oublie DeleteUrlCacheEntry
sous le bouton:

Code:

1
2
3
4
5
6
 
Dim fichier As String
Dim dossier As String
fichier = "acrboimport*.xls"
dossier = GetSpecialFolder(CSIDL_INTERNET_CACHE)
Call chemin(dossier, fichier)

dans le module séparé tu met ça:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
Option Explicit
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
' Enumération des dossiers spéciaux
Public Enum SpecialFoldersConstants
CSIDL_INTERNET_CACHE = &H20
End Enum
' Type
Private Type SHITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As SHITEMID
End Type
' Constantes
Public Const MAX_PATH = 260
Public Function GetSpecialFolder(SpecialFolder As SpecialFoldersConstants) As String
' Les variables
    Dim RC As Long
    Dim IDL As ITEMIDLIST
    Dim sPath As String
     ' Récupère le dossier spécial
    RC = SHGetSpecialFolderLocation(100, SpecialFolder, IDL)
    If RC = 0 Then
        ' Crée un tampon
        sPath = Space$(MAX_PATH)
        ' Récupère le path à partir de l'IDList
        SHGetPathFromIDList ByVal IDL.mkid.cb, ByVal sPath
        ' Supprime les chr$(0) inutiles
        sPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
        'If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    Else
        sPath = ""
    End If
    GetSpecialFolder = sPath
End Function
Public Sub chemin(inp, str)
    Dim doss As Object
    Set doss = CreateObject("scripting.filesystemobject")
    Dim dossier, elem As Variant
    Set dossier = doss.getfolder(inp)
     On Error Resume Next
     doss.deletefile inp & "\" & str, True
     Err.Clear
     For Each elem In dossier.subfolders
    chemin elem.Path, str
    Next
End Sub

testé et ça marche

03/10/2008, 10h05
fthem

Salut
Alors, déja de retour...
j'ai testé ça à l'air de fonctionner sur plusieurs postes diférents, en fait je me suis aperçu que suivant les postes, les ficchiers temporaires ne sont pas stokés au même endroit, penses tu que cela va fonctionner pour tout le monde???
nous somme en Windows NT, mais nous alons passer en Vista, il faut que j'essaie sur un Pc test en vista , j'avais déja adaptées toutes mes autres macros et elles fonctionaient avec Vista , je croise les doigts pour ce code.

Citation:

pour les fichiers csv ne utiliser pas les fichies php que j'ai envoyes ils ne sont pas sur et rediges a la hate c'est une simple demonstation pour te montrer comment ça marche
ces fichiers n'ont pas une protection contre certaines cacacteres et le fichier est a chaque fois ecrit et ecrit penser si sa taille est grande !!

pourquoi me dis tu ça, ça marche impeccable pour moi, seulement je me demande si il y a un texte dans une cellule avec des ; dedans j'ai peur que ce soit interprété comme du code
quand penses tu ??

bonjour
teste ce code pour savoir le dossier internet
Code:

1 2 3 4 5 6 7 8 Sub test() Dim WSHShell As Object Dim ch As String Set WSHShell = CreateObject("WScript.Shell") ch = "%USERPROFILE%\Local Settings\Temporary Internet Files" MsgBox WSHShell.ExpandEnvironmentStrings(ch) End Sub
je ne vois tes commentaires sur ce code
Code:

1 2 3 4 5 6 7 8 9 function send($filename='fichier.xls') { header("Content-type: application/vnd.ms-excel"); header("Content-Disposition: attachment; filename=\"$filename\""); header("Expires: 0"); header("Cache-Control: no-cache, must-revalidate"); readfile($filename);//pour recevoir le contenu du fichier }
Citation:

pourquoi me dis tu ça, ça marche impeccable pour moi, seulement je me demande si il y a un texte dans une cellule avec des ; dedans j'ai peur que ce soit interprété comme du code
quand penses tu ??

tu es libre !!!!!!!!!!!!!!!!!!

Citation:
je ne vois tes commentaires sur ce code
Code:

1 2 3 4 5 6 7 8 function send($filename='fichier.xls') { header("Content-type: application/vnd.ms-excel"); header("Content-Disposition: attachment; filename=\"$filename\""); header("Expires: 0"); header("Cache-Control: no-cache, must-revalidate"); readfile($filename);//pour recevoir le contenu du fichier }
il sagit d'une fonction qui se trouve dans spreadsheet???
Je n'y ai pas touché...
dois je absolument la modIfier???

07/10/2008, 17h31
Montor

Si cette réponse vous satisfait ? Alors n'oubliez pas le Tag:resolu:

Voir 40 message(s) de cette discussion en une page