Entradas

Mostrando entradas de abril, 2020

Eliminar Archivos o Carpetas

Os traigo una macro para Excel que permite eliminar archivos o carpetas. Tened mucho cuidado porque los archivos o carpetas que eliminéis no las podréis recuperar y no van a la papelera de reciclaje. Para que funcione en Excel debemos poner en una columna la rutas que queramos eliminar (por ejemplo la Columna A). La macro va a empezar en la celda que estáis seleccionando (por ejemplo la celda A1) y continuando en las filas siguientes hasta parar en la primera celda que esté en blanco. Este es el código: Sub EliminarArchivo() Ruta = "" Extensión = "" Set Celda = Selection 'Abrir un While que funcione mientras la variable "celda" no este vacia While Celda <> ""     Kill Ruta & Celda.Value &  Extensión       Set Celda = Celda.Offset(1, 0) Wend End Sub Fijaros que la variable  Ruta  está vacía haciendo que se deba poner la ruta entera en la celda (p.e. C:\Prueba\Libro1.xlsx), pero si ponéis la variable  Ruta...

Renombrar Archivos o Carpetas

Os traigo una macro para Excel que permite renombrar los archivos, las carpetas, e incluso mover los archivos  o las carpetas. Para que funcione en Excel debemos hacer dos columnas contiguas: en la primera pondremos la rutas que queramos cambiar (por ejemplo la Columna A), y  en la siguiente columna (es este caso Columna B) la nueva ruta. La macro va a empezar en la celda que estáis seleccionando (por ejemplo la celda A1) y continuando en las filas siguientes hasta la primera celda que esté en blanco. Este es el código: Sub RenombrarDirectorio() Ruta = "" Set Celda = Selection 'Abrir un While que funcione mientras la variable "celda" no este vacia While Celda <> ""     Name Ruta & Celda.Value As Ruta & Celda.Offset(0, 1).Value     Set Celda = Celda.Offset(1, 0) Wend End Sub Fijaros que la variable  Ruta  está vacía haciendo que se deba poner la ruta entera en la celda (p.e. C:\Prueba\Libro1.xlsx), pero si...

Listar Subcarpetas

Os traigo una macro para Excel que empezando en la celda que estáis seleccionando y continuando en las filas siguientes, os va a poner la ruta de las subcarpetas de primer nivel que se encuentren el Ruta del ejemplo ("C:\Prueba\"). Espero que os ayude: Sub ListarDirectorio() Ruta = "C:\Prueba\" For Each DIRECTORIO In CreateObject("Scripting.FileSystemObject").GetFolder(Ruta).SubFolders Selection.Value = DIRECTORIO.Name Selection.Offset(1, 0).Select Next DIRECTORIO End Sub

Listar Archivos de una Carpeta

Os traigo una macro para Excel que empezando en la celda que estáis seleccionando y continuando en las filas siguientes, os va a poner los archivos que se encuentren el Ruta del ejemplo ("C:\Prueba\"). Espero que os ayude: Sub ListarArchivos() Ruta = "C:\Prueba\" For Each ARCHIVO In CreateObject("Scripting.FileSystemObject").GetFolder(Ruta).Files Selection.Value = ARCHIVO.Name Selection.Offset(1, 0).Select Next ARCHIVO End Sub Esta macro no sirve para listar los archivos que se encuentren en subcarpetas de esta dirección, en estos casos deberéis usar la siguiente macro: https://trucosvba.blogspot.com/2020/04/listar-archivos-carpeta-y-subcarpeta.html

Listar Archivos de una Carpeta y sus Subcarpetas

Os traigo una macro para Excel que empezando en la celda que estáis seleccionando y continuando en las filas siguientes, os va a poner los archivos que se encuentren el Ruta del ejemplo y en las subcarpetas del primer nivel ("C:\Prueba\"). Espero que os ayude: Sub LoopListarArchivos() Ruta1 = "C:\Prueba\" For Each DIRECTORIO In CreateObject("Scripting.FileSystemObject").GetFolder(Ruta1).SubFolders Ruta2 = DIRECTORIO & "\" For Each ARCHIVO In CreateObject("Scripting.FileSystemObject").GetFolder(Ruta2).Files Selection.Value = DIRECTORIO.Name Selection.Offset(0, 1).Value = ARCHIVO.Name Selection.Offset(1, 0).Select Next ARCHIVO Next DIRECTORIO End Sub

Función para comprobar que un archivo o directorio existe

Os dejo una función que devuelve un valor verdadero si una ruta existe, puede ponerse tanto una carpeta ("C:\Prueba\") como un archivo ("C:\Prueba\Libro1.xlsx") Como sugerencia, yo lo uso mucho para hacer hipervinculos solamente si el archivo existe. Por Ejemplo: =SI(ComprobarRuta("C:\Prueba\");HIPERVINCULO("C:\Prueba\");"") Advertencia, si usáis en muchas celdas esta función el libro se va a actualizar mas lento, ya que tiene que verificar que las rutas existen. El código que habría que poner para copiar un modulo seria el siguiente: Public Function ComprobarRuta(ByVal Ruta As String) As Boolean If CreateObject("Scripting.FileSystemObject").FileExists(Ruta) Then ComprobarRuta = True If CreateObject("Scripting.FileSystemObject").FolderExists(Ruta) Then ComprobarRuta = True End Function