Cuadro de diálogo para sobreescribir o no un PDF generado
Para Dante Amor
Buenas!
Tengo un código que crea un PDF de una hoja de mi libro y además la envía por email.
Sub Enviar_a_pdf()
Dim Ruta As String
Dim Archivo As String
Dim NombreArchivo As String
Dim Celda As String
Ruta = ActiveWorkbook.Path & "\"
Archivo = ActiveWorkbook.Name
Celda = Cells(9, 8)
NombreArchivo = Ruta & Archivo
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Ruta & Celda, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, From:=1, To:=1, _
OpenAfterPublish:=True
ActiveWorkbook.Save
Rem Enviar Email
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("K15")
dam.Subject = Range("K17")
dam.Body = Range("K19")
dam.Attachments.Add Ruta & Celda & ".pdf"
dam.Send
End Sub
Me gustaría saber cómo hacer para que antes de guardar el PDF compruebe si existe ya un archivo con ese mismo nombre, y me aparezca una alerta con la opción de machacar el archivo o renombrarlo.
1 respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro actualizada.
Sub Enviar_a_pdf()
Dim Ruta As String
'Dim Archivo As String
Dim NombreArchivo As String
Dim Celda As String
Ruta = ActiveWorkbook.Path & "\"
'Archivo = ActiveWorkbook.Name
Celda = Cells(9, "H") & ".pdf"
NombreArchivo = Ruta & Celda
Do While True
If Dir(NombreArchivo) <> "" Then
res = MsgBox("Ya existe un archivo con el mismo nombre: " & vbCr & _
NombreArchivo & vbCr & vbCr & _
"Selecciona Sí para sobreescribir. Selecciona No para escribir un nuevo nombre", _
vbQuestion & vbYesNo, "ALERTA")
If res = vbYes Then
Application.DisplayAlerts = False
Exit Do
Else
NombreArchivo = InputBox("Escribe el nuevo nombre de archivo", "ARCHIVO", NombreArchivo)
If NombreArchivo = "" Then
MsgBox "Archivo invalido", "SE CANCELÓ EL EVNÍO"
Exit Sub
End If
End If
Else
Exit Do
End If
Loop
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=NombreArchivo, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, From:=1, To:=1, _
OpenAfterPublish:=True
ActiveWorkbook.Save
' Enviar Email
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("K15")
dam.Subject = Range("K17")
dam.Body = Range("K19")
dam.Attachments.Add NombreArchivo
dam.Send
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
Hola Dante,
me da este error:
Perdón Dante, funciona perfecto en el PC, el fallo me lo daba desde el Mac pero ahí no lo usaré. El único fallo que da es que si eliges cambiar el nombre al archivo, y en el último cuadro de diálogo le das a cancelar aparece este fallo:
Cambia esta línea:
MsgBox "Archivo invalido", "SE CANCELÓ EL EVNÍO"
Por esta:
MsgBox "Archivo invalido", vbExclamation, "SE CANCELÓ EL EVNÍO"
sal u dos
