I am trying to use the code below to send mail to a client and save the sheet as both a PDF & an xslm file
The PDF works fine an it generates the email perfectly, but I get an error of either when it gets to the lines from FileName2 below to create the xlsm file:
Run time error 1004 - Method 'SaveAs' of object _workbook failed or the file cannot be saved with an xslm extension
Really hope you experts can solve this because it is driving me nuts
Many thanks for looking
The PDF works fine an it generates the email perfectly, but I get an error of either when it gets to the lines from FileName2 below to create the xlsm file:
Run time error 1004 - Method 'SaveAs' of object _workbook failed or the file cannot be saved with an xslm extension
Code:
Sub MailTo()
Dim EmailSubject As String
Dim EmailSignature As String
Dim PDFFile As String
Dim Email_To As String
Dim FileName As String
Dim FileName2 As String
Dim OutApp As Object
Dim OutMail As Object
Dim AlwaysOverwritePDF As Boolean
Dim OverwritePDF As VbMsgBoxResult
Application.ScreenUpdating = False
FileName = Sheets("Quotation").Range("A4").Value
PDFFile = Environ$("userprofile") & "\OneDrive\MJM Services\2.0 Quotations\pdf Copy\" & FileName & ".pdf"
Email_To = Sheets("Quotation").Range("C4").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
AlwaysOverwritePDF = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Sheets("Quotation").Range("C4").Value
.Subject = " Quotation Attached "
.Body = "Many thanks for your request for a quotation" & vbCrLf & vbCrLf & "Please find attached quotation for work detailed" & vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf & "Matt" & vbCrLf & vbCrLf & "M J Mayne Services"
.attachments.Add PDFFile
.Display
End With
ActiveSheet.Copy
FileName2 = Environ$("userprofile") & "\OneDrive\MJM Services\2.0 Quotations\xlsm Copy\" & FileName2 & ".xlsm"
ActiveWorkbook.SaveAs FileName2, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.ScreenUpdating = True
End Sub
Really hope you experts can solve this because it is driving me nuts
Many thanks for looking