Macro para Cambiar extensión de archivo

Por andar haciendo pruebas encontré en este foro el siguiente macro:

Sub listar_archivos() 'Por.DAM

On Error Resume Next

Set navegador = CreateObject("shell.application")

carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, "C:\trabajo").items.Item.Path

If carpeta = "" Then Exit Sub

carpeta = carpeta & "\"

ChDir carpeta

archi = Dir("*.*")

f = 2

Range("A:B").Clear

Do While archi <> ""

Cells(f, "A") = carpeta & archi

Name carpeta & archi As carpeta & archi & ".txt"

Cells(f, "B") = carpeta & archi & ".txt"

f = f + 1

archi = Dir()

Loop

Set navegador = Nothing

End Sub

Pero al ejecutarla le agrego a toda una carpeta la extensión ".txt" y es una cantidad muy grande de archivos para eliminarle uno por uno ¿alguno de uds. Puede ayudarme para dejar mis archivos tal y como estaba?

1 Respuesta

Respuesta
1

Ejecuta esta macro para quitarles ".txt" a todos los archivos

Sub quitartxt()
'Por.DAM
On Error Resume Next
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, "C:\trabajo").items.Item.Path
If carpeta = "" Then Exit Sub
carpeta = carpeta & "\"
ChDir carpeta
archi = Dir("*.*")
f = 2
Do While archi <> ""
  nuevo = Left(archi, Len(archi) - 4)
  Name carpeta & archi As carpeta & nuevo
  archi = Dir()
Loop
End Sub

Saludos.Dante Amor

No olvides finalizar la pregunta

Muchas gracias por tu respuesta, pero al ejecutarlo no pasa absolutamente nada, todo queda igual.

Pero los archivos te quedaron, por ejemplo así:

datos.xlsx.txt

Si los archivos están como el ejemplo, después de ejecutar la nueva macro te deben quedar así:

datos.xlsx

No he recibido comentarios

Puedes finalizar la pregunta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas