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...
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
