Officefull.es

Excel, word, powerpoint, android

Mover Archivos y crear carpetas junio 14, 2008

Excel

Artículo basado en un código realizado por Héctor Miguel Orozco Díaz

En este artículo os vamos a mostrar como podéis crear subcarpetas en un directorio con el mismo nombre que los archivos que existan en un directorio, además de mover dichos archivos a su carpeta correspondiente.

Os ofrecemos dos Procedimientos que podéis ajustar a vuestras necesidades

Códigos realizados en este artículo para una versión superior o igual a MS Office Excel XP

Crear Carpetas

CreateObject("Scripting.FileSystemObject")

Tenemos lo siguiente en un directorio de nuestro Ordenador en este ejemplo →

Unidad → C:\pruebas

Y queremos crear una carpeta por cada archivo que tenemos creado en dicho directorio, pues para ello vamos a hacer lo siguiente →

    • Abrimos un archivo de Excel y le damos a las teclas [ Alt + F11 ] de esta manera abrimos el Editor De Código de VBA de Excel.
    • Nos vamos a menú Insertar → Módulo
    • Ahí en el escenario que nos aparece preparado para escribir código, copiamos y pegamos el siguiente procedimiento →
Sub crear_carpetas() Dim fs, f, f1, fc, s, ruta As String ruta = "c:\pruebas\" Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(ruta) Set fc = f.Files For Each f1 In fc s = Left(f1.Name, 8) On Error Resume Next MkDir ruta & s On Error GoTo mio Next f1 mio: MsgBox "terminado" Set fs = Nothing Set f = Nothing End Sub 'modificado de la ayuda de excel

Cuando ejecutemos el código se nos creará una carpeta por cada archivo con mismo nombre que archivo → 8caracteresincluidos espacios sin extensión.

Mover los Archivos

Ahora necesitamos mover nuestros archivos a su carpeta correspondiente →

Para ello necesitamos el siguiente código de Héctor Miguel, que en lugar de recorrer todo el directorio en busca de su misión tal como realiza el procedimiento anterior… Lo que hace el procedimiento siguiente es:

Recoger los nombres de los archivos y carpetas en Dos Matrices en Excel comparando dichas matrices para luego mover dichos archivos a su Sub-carpeta correspondiente.

Podéis observar el código que os muestro a continuación →

Sub Mover_archivos()     Dim Base As String, sFolder As Object, sFolders(), _     n As Integer, x As Integer, _     Cliente As String, Codigo As String, Cambio As String, _     Nueva As String     Base = "c:\pruebas\"     With CreateObject("scripting.filesystemobject").GetFolder(Base)     ReDim sFolders(.SubFolders.Count)     For Each sFolder In .SubFolders     n = n + 1: sFolders(n) = sFolder.Name: Next: End With     Names.Add "subcarpetas", Join(sFolders, ",")     Names.Add "subcarpetas", _     Split(Evaluate(Names("subcarpetas").RefersTo), ",")     Names.Add "Documentos", _     "=files(""" & Base & "*.rtf"")": Erase sFolders     For n = 1 To Evaluate("counta(documentos)")     On Error Resume Next     Cliente = Evaluate("index(documentos," & n & ")")     On Error GoTo mio     Codigo = Evaluate("left(index(documentos," & n & "),8)")     x = Evaluate("match(""" & Codigo & """,left(subcarpetas,8),0)")     If x Then     Cambio = Base & Evaluate("index(subcarpetas," & x & ")") & "\"     End If     Name Base & Cliente As Cambio & Cliente     n = 0     Next mio:     Names("subcarpetas").Delete: Names("documentos").Delete     MsgBox "terminado"     End Sub  'macro original by Hector Miguel Orozco Díaz acomodada al ariculo 

Si lo deseáis también se puede realizar una llamada al Procedimiento →

Sub crear_carpetas()

Desde la macro de Héctor Miguel Orozco de la siguiente manera →

Debajo de las declaraciones poner →

Call crear_carpetas

Sub Mover_archivos()  Dim Base As String, sFolder As Object, sFolders(), _ n As Integer, x As Integer, _ Cliente As String, Codigo As String, _ Cambio As String, Nueva As String  Call crear_carpetas  'resto del codigo  End Sub 

De esa manera podéis ejecutar solamente un procedimiento que realice todo de una vez, podeis también quitarle el Mesagebox “Terminado” al procedimiento → Sub crear_carpetas()

Finalmente una vez realizado todo correctamente entonces ya nos quedaría todo ordenado [ Archivos dentro de sus carpetas correspondientes ] visualmente de la siguiente manera →

Arbol msdos

 

Categorías: Sin categoría

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *