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
'---------------------------------------------------
'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
http://foro.elhacker.net/programacion_visual_basic/source_cls_clsfiles_multicriterio-t307522.0.html;msg1527333#msg1527333
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!¡.
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