Ayuda borrar solo una extension jpg sin borrar nigun otro archivo

[Otaku=)]

Le pido ayuda.  necesito hacer un code donde solo borre jpg de un subdirectorio. sin que borre otro archivo.  digamos que solo borre las imagenes jpg sin afectar otra extension

Código [Seleccionar] Expandir

'---------------------------------------------------
    'Agregar lña referencia a Microsoft Scripting Runtime
'---------------------------------------------------


Private Sub Command1_Click()
On Error GoTo errsub

    Dim Fso As FileSystemObject
    Dim El_Directorio As Folder

    Screen.MousePointer = vbHourglass
   
    DoEvents
    List1.Clear

   
    Set Fso = New FileSystemObject
    Set El_Directorio = Fso.GetFolder(Trim$(Text1))

    List1.AddItem Trim$(Text1)
   
   ' Comienza a listar las carpetas
    Call Listar_Directorios(El_Directorio)

    Screen.MousePointer = vbDefault
   
'Error
Exit Sub

errsub:
    MsgBox Err.Description, vbCritical
    Screen.MousePointer = vbDefault

End Sub


Private Sub Listar_Directorios(ByVal El_Directorio As Folder)

    On Error GoTo errsub

    ' Variable de tipo Folder
    Dim Subdirectorio As Folder

    ' Recorre los subdirectorios
    For Each Subdirectorio In El_Directorio.SubFolders
        'Agrega el path
        List1.AddItem El_Directorio.Path & "\" & Subdirectorio.Name
           
        'sigue listando los directorios
        Listar_Directorios Subdirectorio
   
    Next

Exit Sub

'Error
errsub:
'Error de permiso denegado
If Err.Number = 70 Then
   Resume Next
   
ElseIf Err.Number = 91 Then
   Screen.MousePointer = vbDefault
   Exit Sub
Else
   MsgBox Err.Description, vbCritical
   Exit Sub
End If
End Sub

Private Sub Form_Load()
    Command1.Caption = " Listar "
    Text1 = "C:\Users\HP\Documents\Messenger Plus\Mis historiales de conversación"
End Sub

Private Sub List1_Click()

    'Variable de tipo FILE y FOLDER para listar los archivos de un path
    Dim El_Archivo As File
    Dim El_Directorio As Folder

    'Si no hay items en el List sale
    If List1.ListIndex = -1 Then Exit Sub
   
    List2.Clear
   
    'Nuevo objeto FileSystemObject
    Set Fso = New FileSystemObject
   
    ' Obtiene el directorio
    Set El_Directorio = Fso.GetFolder(List1.List(List1.ListIndex))
   
   
    ' Lista los ficheros de esta carpeta
    For Each El_Archivo In El_Directorio.Files
       'Añade la ruta
       List2.AddItem El_Archivo.Name
    On Error Resume Next
       
    Kill El_Archivo
        Next El_Archivo

End Sub




[BlackZeroX]

http://foro.elhacker.net/programacion_visual_basic/source_cls_clsfiles_multicriterio-t307522.0.html;msg1527333#msg1527333

Código (vb) [Seleccionar] Expandir



Option Explicit

Private WithEvents ClsScanDisk          As cls_files
Private ThisPath$
Private CountFiles&

Private Sub ClsScanDisk_Begin()
   ThisPath$ = ClsScanDisk.FindInPath
   CountFiles& = 0
   Caption = "ScanDisk ha Encontrado: "
End Sub

Private Sub ClsScanDisk_File(NameFile As String, TypeOfFile As Long, ByVal Atrributes As Long)
   CountFiles& = CountFiles& + 1
   Caption = "ScanDisk ha Encontrado: " & CountFiles&
   Debug.Print ThisPath$ & NameFile   ' <--- en lugar de debug.print pones kill
   Debug.Print vbTab & "Criterio:"; ClsScanDisk.CriterionToFind(TypeOfFile),
   Debug.Print "Atributos:"; Atrributes
End Sub

Private Sub ClsScanDisk_Finish()
   Caption = "ScanDisk ha Encontrado: " & CountFiles& & " -> Finalizado."
End Sub

Private Sub ClsScanDisk_Folder(PathFolder As String, ByVal Atrributes As Long)
   ThisPath$ = PathFolder
End Sub


Private Sub Form_Load()
   If ClsScanDisk Is Nothing Then Set ClsScanDisk = New cls_files
   With ClsScanDisk
       If .ItsRun Then .Stop_
       .CriterionToFind = Split("*.mp3,*.wma,*.avi,*.mid,*.mid", ",") ' en lugar  de esta lista de extensiones pon    split("*.jpg")
       '.CriterionFindDir = vbReadOnly                  '   //  Solo directorios de Solo lectura.
       '.CriterionFindFile = vbHidden Or vbReadOnly     '  //  Solo archivos ocultos.
       .FindInPath = "c:\"
       .AllowEvents = True
       Call .Start_
   End With
End Sub



Existen mas clases para buscar archivos una mas completa es de la de LeandroA.

Dulces Lunas!¡.

[Otaku=)]

mucha gracias por su ayuda. master  pero save el "cls_files" no lo tengo. o me da error  a probar el code la linea

Private WithEvents ClsScanDisk          As cls_files

creo que me esta faltando  algo

[BlackZeroX]

creo que me esta faltando  algo

Lee bien mi Post no falta nada (todo esta en el).

Dulces Lunas!¡.

[Otaku=)]

gracias master.    funciona perfecto