Macro cambiar nombre de archivos de una misma carpeta

H o l a:

Para renombrar un archivo se utiliza la siguiente instrucción:

Name arch1 As arch2

Donde arch1 es el nombre "antiguo" y arch2 es el nombre "nuevo"

Pero tienes que decirme cómo tienes el nombre en la celda, ¿lo tienes con extensión o si extensión?

Puedes poner un par de ejemplos de lo que tienes en las celdas.

Por ejemplo, tienes esto:

         A                            B

1    Anterior               Nuevo

2    imagen                 foto

O tienes esto:

         A                            B

1    Anterior               Nuevo

2    imagen.jpg            foto,jpg

dime exactamente con ejemplos lo que tienes.

sal u dos

Hola Dante, muchas gracias por tu ayuda.

El nombre del archivo están sin extensión, donde, A es el nombre "antiguo" y B el nombre "nuevo".

Existen algunos nombres que no son necesarios cambiar, como la fila 4 y 6 por ejemplo.

Cada nombre contenido en la fila A es el nombre de cada archivo respectivo que se encuentra en la misma carpeta o ruta.

Por favor cualquier duda me avisas.

Muchas gracias.

H o  l a:

Te anexo la macro. En la columna C te va a poner un mensaje.

Si tienes más archivos con más extensiones, agrega el nombre de la extensión en esta línea de la macro:

exts = "JPG, PNG, JPEG, GIF"

Pon la macro en tu archivo de excel y guarda el archivo en la misma carpeta donde tienes los archivos a renombrar.

Sub RenombrarArchivos()
'Por.Dante Amor
    ruta = ThisWorkbook.Path & "\"
    exts = "JPG, PNG, JPEG, GIF"
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(i, "A") <> "" Then
            If Cells(i, "B") <> "" Then
                arch1 = Dir(ruta & Cells(i, "A") & ".*")
                p = InStrRev(arch1, ".")
                ext = Mid(arch1, p + 1)
                arch2 = Cells(i, "B") & "." & ext
                '
                If arch1 <> "" Then
                    Do While arch1 <> ""
                        If InStr(1, exts, UCase(ext)) > 0 Then
                            Name ruta & arch1 As ruta & arch2
                            Cells(i, "C") = "Archivo renombrado"
                            Exit Do
                        End If
                    Loop
                Else
                    Cells(i, "C") = "Archivo NO existe"
                End If
            Else
                Cells(i, "C") = "Falta Archivo en columna B"
            End If
        Else
            Cells(i, "C") = "Falta Archivo en columna A"
        End If
    Next
    MsgBox "fin"
End Sub

':)
'S aludos. D a n t e   A m o r . R ecuerda valorar la respuesta. G racias
':)