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