Se débarrasser d'extensions gênantes

Question

Bonjour à tous,

J'ai dans plusieurs dossiers de mes disques durs (H:\)  et   (I:\)  la présence d'extensions ".TMP" dont je veux me débarrasser mais mon code ci-dessous ne fonctionne pas.
 
Ou se trouve le probleme ???    

Private Sub Form_Load()
Kill ("H:\*.TMP")
Kill ("I:\*.TMP")
End Sub

***Merci***

mortalino · Answer

utilise avec la fonction de PCPT :
http://www.codyx.org/snippet_lister-tous-fichiers-repertoire_198.aspx
(pas sûr que ça liste les sous dossiers.. à voir)

@++ 

<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA

cs_JMO · Answer

Bonjour à tous

Comme ce topic fait suite au 
http://www.vbfrance.com/infomsg_ELIMINER-EXTENSIONS-SATURENT-DISQUES_888961.aspx

ci-dessous une version vbs-wmi adaptable pour vb6.

Option Explicit

Dim strComputer
Dim objWMIService, colDisks, objDisk, colFiles, objFile
strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
 & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")

Set colDisks = objWMIService.ExecQuery _ ("Select * from Win32_LogicalDisk Where DeviceID 'H:' Or DeviceID 'I:'")
        
For Each objDisk in colDisks
    Set colFiles = objWMIService.ExecQuery _
         ("Select * from CIM_DataFile Where Drive = '" & _
           objDisk.Name & "' And Extension = 'TMP'") 
           
    For Each objFile in colFiles
        MsgBox objDisk.Name &vbTab& objFile.Path &vbTab& objFile.Name
        'objFile.Delete,True 
    Next
Next 
Set objWMIService = Nothing
Set colFiles =  Nothing
Set colDisks = Nothing

jean-marc

cs_Exploreur · Answer

Salut,

La réponse étant donné par Mortalino et Jmo (que je salue), devrait largement de convenir...

Pour répondre à ta question : Ou se trouve le probleme ???  dans :

Private Sub Form_Load()
Kill ("H:\*.TMP")
Kill ("I:\*.TMP")
End Sub

J'espère pour toi que tout tes fichiers ne se prénome pas *.Tmp, d'ailleurs tu ne pourrais en avoir qu'un seul dans un même répertoire....Mais il ne t'es pas venu à "l'esprit" qu'il manquait peut-être un nom de fichier...Lol...Elle est là ta réponse...

Ce n'est pas méchant que je dit cela, mais défois il suffit juste de bien regarder son code pour comprendre l'erreur...

  

A+
Exploreur

 Linux a un noyau, Windows un pépin

browser64 · Answer

Bonjour Re:

J'ai besoin d'utiliser ce Code avec la fonction KILL non pas le Wmi-vbs adaptable VB6.

mortalino · Answer

utilise avec la fonction de PCPT :
http://www.codyx.org/snippet_lister-tous-fichiers-repertoire_198.aspx
(pas sûr que ça liste les sous dossiers.. à voir)

@++ 

<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA

PCPT · Answer

salut, suite à ton MP ????? (qu'est-ce que j'ai à voir là dedans moi ) Peux tu me corriger le code ci-dessous car je voudrai supprimer les extensions .TMP se trouvant dans plleins de repertoires des disques H/\ et I:\. Ou se trouve le problème ?? Merci beaucoup Function GetFilesPathFromDirectory(ByVal sDir As String, ByRef aRet() As String, Optional ByVal sFilter As String = ".TMP") As Long GetFilesPathFromDirectory = -1 Erase aRet If RightB$(sDir, 2) <> "" Then sDir = sDir & "" Dim sFile As String, lIndex As Long If sFile <> vbNullString Then lIndex = 0 ReDim aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Do While sFile <> vbNullString lIndex = UBound(aRet) + 1 ReDim Preserve aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Loop GetFilesPathFromDirectory = lIndex End If End Function Private Sub Form_Load() Dim aResultat() As String Dim Folder As String Dim lRet As Long Dim i As Long Folder = "H:" Folder = "I:" lRet = GetFilesPathFromDirectory(Folder, aResultat(), ".TMP") If lRet <> -1 Then For i = 0 To lRet Name aResultat(i) As LeftB$(aResultat(i), LenB(aResultat(i)) - 10) Next i End If End Sub corriger quoi? quel est le problème? tu vois quoi, supprimer le fichier ou renommer pour enlever l'extension toi ce que tu fais : *tu cherches UNIQUEMENT dans I:\ *tu renommes tous les "FICHIERS.TMP" en "FICHIER" lenb - 10 => X.TMP merci de ne pas utiliser ma messagerie pour ce genre de demande, surtout aussi abstraite... donc? tu veux quoi? ++

Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp

mortalino · Answer

Rhalala !  je me sens coupable ! Bonjour PCPT et désolé qu'il t'innonde de MP suite au lien ^^
(heureusement qu'il n'est pas en VBA, sinon c'était pour ma tronche )

@++ 

<hr size="2" width="100%" />( Nouveau forum : Exclusivement Office & VBA

PCPT · Answer

un seul MP, pas la fin du monde 

reste à attendre des explications plus claires

browser64 · Answer

Bonjour à tous Re: En fait je veux supprimer toutes les extensions ".TMP" Donc...en réponse à ta demande et je m'excuse de mon message privé mais voila, sur le code ci-dessous je voudrai virer toutes les extentions .TMP de mes disques durs H:\ et I: et cela dans tout les répertoires confondus. Ce code ne me supprime pas les extensions .TMP des disques, Peut-on me corriger ce code ? Merci Function GetFilesPathFromDirectory(ByVal sDir As String, ByRef aRet() As String, Optional ByVal sFilter As String = ".TMP") As Long GetFilesPathFromDirectory = -1 Erase aRet If RightB$(sDir, 2) <> "" Then sDir = sDir & "" Dim sFile As String, lIndex As Long If sFile <> vbNullString Then lIndex = 0 ReDim aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Do While sFile <> vbNullString lIndex = UBound(aRet) + 1 ReDim Preserve aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Loop GetFilesPathFromDirectory = lIndex End If End Function Private Sub Form_Load() Dim aResultat() As String Dim Folder As String Dim lRet As Long Dim i As Long Folder = "H:" Folder = "I:" lRet = GetFilesPathFromDirectory(Folder, aResultat(), ".TMP") If lRet <> -1 Then For i = 0 To lRet Name aResultat(i) As LeftB$(aResultat(i), LenB(aResultat(i)) - 10) Next i End If End Sub

cs_lermite222 · Answer

Bonjour,


Il faudrait passer tout les répertoirs en revue ?


Voir sur ce lien de MS



http://support.microsoft.com/default.aspx?scid=KB;EN-US;q185601&ID=KB;EN-US;q185601

A+

PCPT · Answer

en français : récursivité. voir les sources existantes

et t'es toujours aussi évasif browser64. heureusement que tu commences par KILL pour nous laisser comprendre que tu cherches à supprimer. mais alors pourquoi faire un NAME AS (renommer) ?

exploreur ->
"J'espère pour toi que tout tes fichiers ne se prénome pas *.Tmp,
d'ailleurs tu ne pourrais en avoir qu'un seul dans un même
répertoire....Mais il ne t'es pas venu à "l'esprit" qu'il manquait
peut-être un nom de fichier...Lol...Elle est là ta réponse..."
tu arrives à mettre * dans un nom de fichier?
* concerne tous les fichiers.
kill "D:\*.EXT" fonctionne. on va bien supprimer tous les fichiers à la RACINE du disque dont l'EXT est indiquée.
mais pas dans les sous-dossiers...
 
<hr size="2" width="100%" />Prenez un instant pour répondre à [infomsg_SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp

browser64 · Answer

Re: J'ai recuperé un code bien plus pratique ou je veux virer les extensions ".EFRST" de tout mes disques. Voir le code ci-dessous, mais celui-ci me fait une erreur. Merci a tous ---------------------------------- 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, ".ESTFR") > 0) Then StrExtention ".ESTFR" 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 & ".ESTFR" & 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 = ".ESTFR") 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() Kill (StrExtention) End Sub

cs_Exploreur · Answer

Bonsoir à tous,

PCPT >> Défois.....Je...Hum...

browser64, précise l'erreur...

A+
Exploreur

 Linux a un noyau, Windows un pépin

browser64 · Answer

oui Exploreur..............donc je n'ai pas de messages d'erreur mais les extensions ".ESTFR" ne s'effacent pas................

Se débarrasser d'extensions gênantes

14 réponses

Votre réponse

Discussions similaires