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

Respuesta
1

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 :)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas