Como crear carpeta con un libro dentro automáticamente
Tengo la siguiente pregunta como se podrá al abrir un libro crear automáticamente una carpeta con un nombre determinado y dentro de ella un libro también con un nombre determinado. Ya logre hacer lo primero con la siguiente instrucción pero me falta lo segundo, alguien podrá orientarme de favor.
Sub CrearCarpetas() If Dir(ThisWorkbook.Path & "\Resguardo Entregado", vbDirectory) = "" Then MkDir ThisWorkbook.Path & "\Resguardo Entregado" MsgBox "Carpeta Resguardo Entregado creada.", vbInformation End If End Sub
1 respuesta
A ver, pruébalo así, modificado (cambia el nombre del libro):
Sub CrearCarpetas() Application.ScreenUpdating = False Dim nCarpeta As String: nCarpeta = ThisWorkbook.Path & "\Resguardo Entregado" Dim nLibro As String: nLibro = nCarpeta & "\Nombre del libro.xls" 'cambia el nombre del libro' 'crear la carpeta si no existe' If Dir(nCarpeta, vbDirectory) = "" Then MkDir nCarpeta End If 'crear el libro' Workbooks.Add ActiveWorkbook.SaveAs Filename:=nLibro, FileFormat:=51 ActiveWorkbook.Close 'hecho' MsgBox "Carpeta Resguardo Entregado creada.", vbInformation Application.ScreenUpdating = True End Sub
Andy
Andy Machin muchas gracias por tu aportación, funciona bien en la primera ejecución pero cuando lo ejecuto por segunda vez me pregunta si quiero remplazar el libro nuevo y lo lógico seria que si ya existe la carpeta con el archivo ya no pregunte.
Andy Machin tema cerrado ya quedo así finalmente. Muchas gracias.
Sub CrearCarpetas() Application.ScreenUpdating = False Dim nCarpeta As String: nCarpeta = ThisWorkbook.Path & "\Resguardo Entregado" Dim nLibro As String: nLibro = nCarpeta & "\Resguardo Entregado.xlsm" 'cambia el nombre del libro' 'crear la carpeta si no existe' If Dir(nCarpeta, vbDirectory) <> "" Then Exit Sub If Dir(nCarpeta, vbDirectory) = "" Then MkDir nCarpeta End If 'crear el libro' Workbooks.Add ActiveWorkbook.SaveAs Filename:=nLibro, FileFormat:=52 ActiveWorkbook.Close 'hecho' MsgBox "Carpeta Resguardo Entregado creada.", vbInformation Application.ScreenUpdating = True End Sub
Si, cierto. Usa este código corregido:
Sub CrearCarpetas() Application.ScreenUpdating = False Dim nCarpeta As String: nCarpeta = ThisWorkbook.Path & "\Resguardo Entregado" Dim nLibro As String: nLibro = nCarpeta & "\Nombre del libro.xls" 'crear la carpeta si no existe' If Dir(nCarpeta, vbDirectory) = "" Then MkDir nCarpeta End If If Len(Dir(nLibro)) = 0 Then 'crear el libro' Workbooks.Add ActiveWorkbook.SaveAs Filename:=nLibro, FileFormat:=51 ActiveWorkbook.Close 'hecho' MsgBox "El libro ha sido creado correctamente.", vbInformation End If Application.ScreenUpdating = True End Sub
Andy
Ah vale, esa variante también es valida :)
