Crear carpeta en el escritorio y guardar archivos dentro

Tengo el siguiente código el cual me colaboraron en crear muy amablemente, tengo un botón que al oprimir activa la macro, pero necesito que al oprimir el botón se cree una nueva carpeta nombrada con el valor de la celda j9, y queden dentro de ella un pdf de la hoja activa llamado propuesta con nombre de la celda j7 y a su vez quede grabado el libro en formato habilitado para macros con nombre del valor de la celda j8, muchas gracias

Set h1 = Sheets("PROPUESTA")
    carpeta = "C:\trabajo\" & Trim(h1.[J9])
    aPdf = h1.[J7]
    aMacro = h1.[J8]
    If Dir(carpeta, vbDirectory) = "" Then MkDir carpeta
    If Right(carpeta, 1) <> "\" Then carpeta = carpeta & "\"
    h1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=carpeta & aPdf & ".pdf"
    ActiveWorkbook.SaveCopyAs carpeta & aMacro & ".xlsm"
    MsgBox "Fin"

1 respuesta

Respuesta
1

H o l a:

Cambia la macro por el siguiente código:

Sub GuardarPdf()
'Por.Dante Amor
    Set h1 = Sheets("PROPUESTA")
    ruta = escritorio
    If ruta = "" Then
        MsgBox "No se encotró la carpeta Escritorio", vbCritical, "ERROR"
        Exit Sub
    End If
    '
    carpeta = ruta & Trim(h1.[J9])
    aPdf = h1.[J7]
    aMacro = h1.[J8]
    If Dir(carpeta, vbDirectory) = "" Then MkDir carpeta
    If Right(carpeta, 1) <> "\" Then carpeta = carpeta & "\"
    h1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=carpeta & aPdf & ".pdf"
    ActiveWorkbook.SaveCopyAs carpeta & aMacro & ".xlsm"
    MsgBox "Proceso terminado", vbinformatio, "GUARDAR PDF"
End Sub
Function escritorio() As String
'Por.Dante Amor
'Referencia: http://www.ozgrid.com/forum/showthread.php?t=24985
    Dim objWSHShell As Object
    Dim strSpecialFolderPath
    On Error GoTo ErrorHandler
    Set objWSHShell = CreateObject("WScript.Shell")
        escritorio = objWSHShell.SpecialFolders("Desktop")
    Set objWSHShell = Nothing
    Exit Function
ErrorHandler:
    escritorio = ""
End Function

no se porque no me esta quedando grabado en el escritorio, sino en el C

Después de esta línea

carpeta = ruta & Trim(h1.[J9])

Pon esta línea

msgbox carpeta

Y dime qué te está poniendo en el mensaje

disculpa la demora en contestar 

avisame si se ve la imagen por favor 

Cambia esta línea

carpeta = ruta & Trim(h1.[J9])

Por esta:

carpeta = ruta & "\" & Trim(h1.[J9])

Prueba y me comentas.

Si ya te está funcionando, r ecuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas