I have code for a command button to save an active Excel file as pdf and then open it in Outlook for the user to send as an email.
However, this requires the user to save the file as a pdf before it opens it in Outlook. It works perfectly if the user wants to save a copy to their files.
What if the user wants to use the submit button but doesn't want to save a copy off and cancels that process? With the code I have below, it just fails out.
Is it possible to code it so that if the user decides they don't want to save a copy off, that it will default to send an email with the active excel file attached instead?
Private Sub CommandButton1_Click()
'
Dim OutApp As Object
Dim OutMail As Object
Dim v As Variant
v = Application.GetSaveAsFilename(Range("A4").Value, "PDF Files (*.pdf), *.pdf")
If Dir(v) <> "" Then
If MsgBox("File already exists - do you wish to overwrite it?", vbYesNo, "File Exists") = vbNo Then Exit Sub
End If
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=v, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = ""
.Attachments.Add v
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Try the following
Option Explicit
Private Sub CommandButton1_Click()
Dim msg As String
msg = "Would you like to save this file as pdf?"
If MsgBox(msg, vbYesNo) = vbYes Then
Dim v As Variant
v = Application.GetSaveAsFilename(Range("A4").Value, _
"PDF Files (*.pdf), *.pdf")
If Dir(v) <> "" Then
If MsgBox("File already exists - do you wish to overwrite it?", _
vbYesNo, "File Exists") = vbNo Then 'Exit Sub
End If
End If
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, fileName:=v, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=False
End With
Else
ActiveWorkbook.Save
v = ActiveWorkbook.path & "\" & ActiveWorkbook.Name
End If
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = ""
.Attachments.Add v
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.