Macro Excel para guardar en PDF en determinado directorio

.17/11/16

Buenas noches, Joaom

Disculpa la demora, pero vengo con semanas muy cargadas de trabajo.

El siguiente código se encarga de controlar la existencia de un directorio y, en caso de no encontrarlo, te consulta si deseas que lo cree o no.

Sub ChkDir()
'Control de Existencia del Carpeta
a_DirPrinc = "C:\0\"
On Error Resume Next
ChDir a_DirPrinc
If Err = 76 Then
    Err = 0
    QueHago = MsgBox("la carpeta " & a_DirPrinc & " NO existe." & Chr(10) & "¿La creo?", vbOKCancel, "NO ESTA ¿QUE HAGO?")
    If QueHago = 1 Then
        MkDir a_DirPrinc
    Else
        Exit Sub
    End If
End If
On Error GoTo 0
End Sub

Espero que te sea de utilidad.

Un abrazo

Fer

Pd = Sé que te adeudo algo, pero estoy trabajandolo aún. Creo que pronto tendrás novedades.

.

Hola fejoal, Gracias por tomarte tu tiempo

La macro le agregue algo para que cree las 2 carpetas (Carpeta C:\1  y la sub-carpeta C:\1\prueba

Lo hice tipo indio (com ose dice por aqui) a trocha y mocha

Como la dejaste crea la principal pero la sub-carpeta no, se pongo

a_DirPrinc = "C:\1\Prueba\"  no crea nada, ni la C:\1

si la dejo como la ves si crea las 2

Sub ChkDir()
'Por: fejoal = Fernando
'Control de Existencia del Carpeta
a_DirPrinc = "C:\1\"
b_DirSecun = "C:\1\Prueba\" 'ESTE
On Error Resume Next
ChDir a_DirPrinc
ChDir b_DirSecun
If Err = 76 Then
    Err = 0
    QueHago = MsgBox("la carpeta " & b_DirSecun & " NO existe." & Chr(10) & "¿La creo?", vbOKCancel, "NO ESTA ¿QUE HAGO?")
    If QueHago = 1 Then
        MkDir a_DirPrinc
        MkDir b_DirSecun 'ESTE
    Else
        Exit Sub
    End If
End If
On Error GoTo 0
End Sub

Si tienes una forma mas diplomatica de programarlo, bien venida sea

De cualquier forma ya la del amigo Dante da la solución que deseaba

.

Buenas, Joao

En realidad, deberías hacerlo en dos pasos, como verás en la siguiente variante de tu rutina:

Sub ChkDir()
'Por: fejoal = Fernando
'Control de Existencia del Carpeta
a_DirPrinc = "C:\1\"
b_DirSecun = "C:\1\Prueba\" 'ESTE
On Error Resume Next
ChDir a_DirPrinc 'controla existencia de la carpeta principal
If Err = 76 Then
    Err = 0
    QueHago = MsgBox("la carpeta " & b_DirPrinc & " NO existe." & Chr(10) & "¿La creo?", vbOKCancel, "NO ESTA ¿QUE HAGO?")
    If QueHago = 1 Then
        MkDir a_DirPrinc
    Else
        Exit Sub
    End If
End If
'
ChDir b_DirSecun 'controla existencia de la carpeta secundaria
If Err = 76 Then
    Err = 0
    QueHago = MsgBox("la carpeta " & b_DirSecun & " NO existe." & Chr(10) & "¿La creo?", vbOKCancel, "NO ESTA ¿QUE HAGO?")
    If QueHago = 1 Then
        MkDir a_DirSecun
    Else
        Exit Sub
    End If
End If
On Error GoTo 0
End Sub

Con esto debería funcionar.

Abrazo!
Fer

Pd: Ya te envié a tu correo la rutina que me habías solicitado.

.

Pregunta si quiero crar acepto pero al menos la Prueba no la crea

Te anexo la macro actualizada

Sub guardapdf()
'Por.Dante Amor
    uf = ActiveCell.SpecialCells(xlLastCell).Row
    rut = "C:\0\"
    rut = "c:\trabajo\"
    carp = Range("E4") 'EL NOMBRE QUE EXISTA EN E4
    If carp = "" Then
        MsgBox "Captura la carpeta"
        Exit Sub
    End If
    If Right(carp, 1) <> "\" Then carp = carp & "\"
    If Dir(rut & carp, vbDirectory) = "" Then
        MkDir (rut & carp)
    End If
    '
    Range("A1:O" & uf).Select
    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=rut & carp & Range("m3") & " - " & Range("g3") & " - " & Range("d7") & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    MsgBox "Se ha guardado en " & rut & carp
End Sub

sal u dos

E stimado, tienes pendiente valorar esta respuesta:

ListBox en Formulario para búsqueda entre-fechas

Hola Dante.

Ya la valoré hace tiempo atrás, te dejo imagen

Quiero que sepas que yo jamas dejo y dejaré de calificar algo aunque sea mínima la ayuda o poco instructiva.

Además al amigo que tanto me ha ayudado, jamas dejaría de calificarlo COMO EXCELENTE

G racias, seguro es problema del sistema de todoexpertos. Nuevamente gracias por tomarte el tiempo de revisarlo. Sal u dos

Yo jamas te fallaria siendo tu tan espontaneo en ayudar, no solamente a mi persona, si no a tantos otr@s.

Dante, la macro al ejecutarla SIN QUE EXISTA la carpeta con la sub-carpeta me manda este error y porque la carpeta y sub no existen. si la creo yo manualmente si va.

Como expuse arriba, quisiera no tener que hacerlo yo manualmente la creaciomn de la carpeta y sub-carpeta, que la macro las cree SI NO EXISTEN.

C:\1 es la carpeta a crear SI NO EXISTE y E4 es la sub-carpeta a crear SI NO EXISTE.

Ejemplo quedaria  C:\1\Jota

Jota es dato en E4 y E4 tiene escrito Jota

Sub guardapdf()
'Por.Dante Amor
    uf = ActiveCell.SpecialCells(xlLastCell).Row
    rut = "C:\1\" 'carpeta a crear SI NO EXISTE
    carp = Range("E4") 'Sub-Carpeta a crear SI NO EXISTE (valor de E4)
    If carp = "" Then
        MsgBox "Captura la carpeta"
        Exit Sub
    End If
    If Right(carp, 1) <> "\" Then carp = carp & "\"
    If Dir(rut & carp, vbDirectory) = "" Then
        MkDir (rut & carp)
    End If
    '
    Range("A1:O" & uf).Select
    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=rut & carp & Range("m3") & " - " & Range("g3") & " - " & Range("d7") & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    MsgBox "Se ha guardado en " & rut & carp
End Sub

Debe existir la ruta c:\1

Lo que va a hacer la macro es crear la carpeta jota

Pues eso, lo que no quería es crear manualmente porque para tener que crear manualmente una (C:\1) se crea también la Jota (C:\1\Jota)