*Libérer de l'espace sur ses disques*

Question

Bonjour à tous. Sur mon code ci-dessous je veux enlever les extensions ".EFRST" de mes disques durs mais en executant mon programme ces extensions ne s'effacent pas. Ou se trouve l'erreur ?? peut-on me corriger ce code car je galère. Merci. Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Const DRIVE_REMOVABLE = 2 Const DRIVE_FIXED = 3 Const DRIVE_REMOTE = 4 Const DRIVE_CDROM = 5 Const DRIVE_RAMDISK = 6 Const FILE_ATTRIBUTE_ARCHIVE = &H20 Const FILE_ATTRIBUTE_COMPRESSED = &H800 Const FILE_ATTRIBUTE_DIRECTORY = &H10 Const FILE_ATTRIBUTE_HIDDEN = &H2 Const FILE_ATTRIBUTE_NORMAL = &H80 Const FILE_ATTRIBUTE_READONLY = &H1 Const FILE_ATTRIBUTE_SYSTEM = &H4 Const MAX_PATH = 260 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Function GetAllDrivesFolders(Dossier As String, IntSubDir As Integer, StrExtention As String) As Integer Dim wfd As WIN32_FIND_DATA Dim hFichier As Long Dim StrFichier As String Dim StrChemin As StringIf (StrExtention "") Or (InStr(StrExtention, ".EFRST") > 0) Then StrExtention ".EFRST" StrExtention = LCase$(StrExtention) StrChemin = Dossier If Right(StrChemin, 1) <> "" Then StrChemin = StrChemin & "" wfd.dwFileAttributes = FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_COMPRESSED Or FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_SYSTEM hFichier = FindFirstFile(StrChemin & ".EFRST" & Chr(0), wfd) If hFichier <> -1 Then Do StrFichier = TrimNull(wfd.cFileName) If (wfd.dwFileAttributes And vbDirectory) Then If (StrFichier <> ".") And (StrFichier <> "..") And (IntSubDir = 1) Then GetAllDrivesFolders StrChemin & StrFichier, IntSubDir, StrExtention End If ElseIf (InStr(StrExtention, LCase(ExtractExt(StrFichier))) > 0) Or (StrExtention = ".EFRST") Then Form1.List1.AddItem StrFichier End If wfd.dwFileAttributes = FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_COMPRESSED Or FILE_ATTRIBUTE_DIRECTORY Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_SYSTEM Loop While FindNextFile(hFichier, wfd) End If Call FindClose(hFichier) End Function Function TrimNull(StrChaine As String) As String On Error Resume Next Dim Posi As Integer Posi = InStr(StrChaine, Chr(0)) If Posi Then TrimNull = Left(StrChaine, Posi - 1) Exit Function End If TrimNull = StrChaine End Function Function ExtractExt(Fiche As String) As String On Error Resume Next Dim Posi As Integer ExtractExt = Fiche #If VB5 Then Posi = String_Instrrev(Fiche, ".") #Else Posi = InStrRev(Fiche, ".") #End If If Posi = 0 Then Exit Function ExtractExt = Mid(Fiche, Posi) End Function Function String_Instrrev(Chaine As String, RchStr As String) As Long Dim Position As Long Dim CmptSplit As Integer CmptSplit = 0 Position = 0 For Position = Len(Chaine) To 1 Step -1 If Mid(Chaine, Position, Len(RchStr)) = RchStr Then String_Instrrev = Position Exit Function End If Next String_Instrrev = 0 End Function Private Sub Form_Load() Dim Str_Temp As String * 250 Dim PosiStop As Integer Dim PosiStart As Integer GetLogicalDriveStrings Len(Str_Temp), Str_Temp PosiStop = 1 PosiStart = 1 Do PosiStop = InStr(PosiStop, Str_Temp, Chr(0)) If PosiStop = 0 Then Exit Do Select Case GetDriveType(Mid(Str_Temp, PosiStart, PosiStop - PosiStart)) Case DRIVE_REMOVABLE DeleteFile UCase$(Mid$(Str_Temp, PosiStart, PosiStop - PosiStart - 1)) Case DRIVE_FIXED DeleteFile UCase$(Mid$(Str_Temp, PosiStart, PosiStop - PosiStart - 1)) Case DRIVE_REMOTE DeleteFile UCase$(Mid$(Str_Temp, PosiStart, PosiStop - PosiStart - 1)) Case DRIVE_CDROM DeleteFile UCase$(Mid$(Str_Temp, PosiStart, PosiStop - PosiStart - 1)) Case DRIVE_REMOTE DeleteFile UCase$(Mid$(Str_Temp, PosiStart, PosiStop - PosiStart - 1)) End Select PosiStart = PosiStop + 1 PosiStop = PosiStop + 2 Loop DeleteFile ListIndex = 0 End Sub

cs_casy · Answer

Déjà commence par bien analyser ce que tu fais dans le Form_Load. Tu comprendras déjà que tout le reste du code ne sert à rien puisqu'il n'est jamais appelé.

Ensuite lorsque tu fais DeletFile UCase$... regarde le nom du fichier que tu essaye d'effacer, je dirais que c'est normal que ça ne marche pas.

Concernant DeleteFile ListIndex =   0, je cromprend pas bien le but, d'ailleurs le compilateur non plus, il jette une erreur dessus

  ---- Sevyc64  (alias Casy) ----  <hr size  ="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #    http://aide-office-vba.monforum.com/index.php

browser64 · Answer

RE:

Merci de te conseils Casy, mais que dois-je mettre pour que mon code fonctionne ??


 


Merci

cs_casy · Answer

ben je sais pas, déjà dans ton Form_Load tu essaye d'éffacer la racine de chaque disque installer sur le système. C'est pas bon, déjà on ne peut pas effacer un racine, on ne peut qu'éffacer des fichiers (éventuellement des dossiers).

Puis avec DeleteFile, il faut que tu lui passe le nom du fichier à efffacer. Donc si tu as plusieurs fichiers à effacer, il va falloir faire une boucle sur la liste des fichiers. A condition tout d'abords de creer cette liste. J'imagine que c'est le but du code qe tu as avant le form_load, mais seulement tu ne l'appelle jamais, donc tu risque pas de creer la liste.

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #    http://aide-office-vba.monforum.com/index.php

browser64 · Answer

RE:

Oui effectivement j'ai un soucis sur mon code, j'y suis presque mais je trouve pas la solution pour que les extension soient effacées de tous les disques, pourant le principe est simple....

c'est juste un petit bout de mon code a corriger.........ou est cette erreur ??? je cherche , je cherche.........

cs_casy · Answer

Si j'ai bien compris c'est la fonction GetAllDriveFolder qui va rechercher tes fameux fichiers et remplir une liste.

Il va donc bien faloir à moment donner appeler cette fonction sur chaque disque trouvé sur ton système.

Ensuite, une fois que ta liste est remplie, il va falloir faire une boucle sur chaque élément de cette liste pour effacer le fichier correspondant. 

Pour l'instant avec le code que tu as publier dans ta question, tu ne fait même pas la recherche de fichier, tu ne peux donc pas les effacer.

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #    http://aide-office-vba.monforum.com/index.php

browser64 · Answer

je viens de faire plusieurs essais mais je n'y arrive pas.........toi casy tu as fais un essai pour voire si de ton côté t'a une solution.....car je cherche......c'est chaud........

thanks

cs_casy · Answer

Pourtant si tu remplace dans le Form_Load, les DeleteFile UCase$(....) par des GetAllDriveFolder(UCase$(..),1,".EFRST") et qu'ensuite tu remplace le DeleteFile ListIndex=  0 qui ne veut rien dire par une boucle du style

Pour chaque élément de la liste
    DeleteFile Liste.Element
FinBoucle

Je pense que tu ne devrais pas etre très loin du résultat

Et non je n'ai pas essayer encore de même que je ne suis pas vraiment penché sur le code de tes fonctions car n'étant pas indenté, aéré, ... il est assez illisible et qu'en plus je fais autre chose en même temps et deplus le problème initial ne venait pas de ce code puiqu'il n'est pas appelé. Mais vu la façon dont il semble écrit, ça doit etre un code que tu as récupéré dans un exemple, ou peut-etre même ici dans les sources.

  ---- Sevyc64  (alias Casy) ----  <hr size  ="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #    http://aide-office-vba.monforum.com/index.php

browser64 · Answer

Je vais tester ca casy..............je te tiens au jus.

Thanks

browser64 · Answer

je n'y arrive pas.............tu pourrais pas me corriger le code , et me le remettre........

thanks a toi casy

browser64 · Answer

Re:

 j'ai une erreur sur le code ci-dessous.

J'ai une fenetre qui me dit :  "erreur de compilation variable non definie".....dans list.1

pourtant cette variable semble etre bonne car elle devrait bien se gerer......

Libérer de l'espace sur ses disques

10 réponses

Votre réponse

Discussions similaires