Visual Basic macro crear carpeta en otra ruta
Estoy con una macro para crear una carpeta en otra ruta y guardar ahí una copia del fichero actual. Por alguna razón la carpeta no se crea... ¿Podéis ayudarme a revisar el código? Gracias
Dim sruta as string
Dim nombrecarpeta as string
Dim sseparadorruta as string
Dim snombrelibroactual as string
snombrelibroactual = Application.ActiveWorkbook.name
ssperadorruta = Application.Pathseparator
sruta = "C:\users\ana\documents"
nombrecarpeta = CStr(Format (date, "dd-mm-yyy")) _
& "-" & Cstr(Format(Time, "hh-mm-ss"))
Application.ActiveWorkbook.SavecopyAs Filename:=sruta _
& sseparadorruta & nombrecarpeta & sseparadorruta & snombrelibroactual
End Sub
En concreto me da error en las últimas dos líneas, dice que no puede guardar la copia porque no encuentra el destino, la carpeta no se crea...
1 respuesta
Tienes mal el nombre de la variable:
Dim sseparadorruta as string
Y la utilizas así: (te falta la primera letra "e")
ssperadorruta = Application.PathSeparator
Y luego la tienes con la letra "e":
Application.ActiveWorkbook.SaveCopyAs Filename:=sruta & sseparadorruta & nombrecarpeta & sseparadorruta & snombrelibroactual
Te recomiendo que al inicio de todo tu código utilices la siguiente instrucción:
Option Explicit
De esa manera, VBA te revisa el nombre de todas las variables, por supuesto, deberás declarar todas las variables de manera correcta, pero eso te ayudará a evitar algunos errores en el código.
Otra recomendación, es que utilices nombres de variables más cortos, son más fáciles de leer y de escribir.
Prueba así:
Sub crea_carpeta() Dim sRuta As String, sCarpeta As String, sSep As String, sLibro As String sLibro = Application.ActiveWorkbook.Name sSep = Application.PathSeparator sRuta = "C:\users\ana\documents\" 'Poner \ al final de la ruta If Dir(sRuta, vbDirectory) = Empty Then MsgBox "No existe la ruta: " & sRuta Exit Sub End If ' sCarpeta = CStr(Format(Date, "dd-mm-yyy")) & "-" & CStr(Format(Time, "hh-mm-ss")) If Dir(sRuta & sCarpeta, vbDirectory) = Empty Then MkDir sRuta & sCarpeta End If ' ActiveWorkbook.SaveCopyAs sRuta & sCarpeta & sSep & sLibro End Sub
