# VBA code to convert excel to pdf and email it as attachment



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## Michael M

Hi and welcome to the Board
Her's an example of what you need, but you will either need toprovide more info on what cells contain the required data, or make changes as commented on the code



		Code:
__


Sub DoALLsingle()
Dim tempPDFFileName, tempPSFileName, tempPDFRawFileName As String, mypdfDist As New PdfDistiller, _
 i As Integer, Mail_Object, Email_Subject, o As Variant
    tempPDFRawFileName = "G:\Temp\" & ActiveWorkbook.Name ' Change File Path to suit
    tempPSFileName = tempPDFRawFileName & ".ps"
    tempPDFFileName = tempPDFRawFileName & ".pdf"
    ActiveSheet.PrintOut Copies:=1, preview:=False, ActivePrinter:="Adobe PDF", _
        printtofile:=True, Collate:=True, prtofilename:=tempPSFileName
    mypdfDist.FileToPDF tempPSFileName, tempPDFFileName, ""
     Kill tempPSFileName
Set mypdfDist = Nothing

'************End of PDF section*************
'************Start of emailing code*********
    Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)
            .Subject = "TEXT IN HERE" ' CHANGE TO SUIT
            .To = "RECIPIENT IN HERE" 'CHANGE TO SUIT
            .Body = "E MAIL TEXT GOES HERE" & Chr(13) & Chr(13) & "Regards," & Chr(13) & "YOUR NAME." & Chr(13) & "YOUR ADDRESS." 'Change comments to suit
            .Attachments.Add tempPDFFileName
            .Send
    End With
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub


----------



## ZVI

The template code for Excel 2007+ with its own PDF converter:


		Rich (BB code):
__


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A1")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## aarondesin91

Hey guys,
Thank alot for your help here. Really appreciate your help here. But i face a problem. When trying to paste your code i have a problem .

So guys that wat my screen shows. Im not sure didn’t I paste the code in the correct place. So please guys help me out here.

Thank alot


----------



## Michael M

Can't see the image ??
So, what is the problem ??
Either code must go in Standard module OR "This Workbook" module
It can then either be run by Pressing ALT + F8 and selecting the macro
oR
asigning it to a button / shape / menu


----------



## aarondesin91

Hey,
Thank for the help. I think my problem is that I don't know where  to paste the code and also the reference. So can you guide me where to paste the code, please..

Thank you.


----------



## ZVI

What is Excel version on your PC?


----------



## ZVI

Michael's code works in all Excel versions but additionally requires Abobe Acrobat software which is not freeware.

My code works in Excel 2007, 2010, 2013 only, but without any additional software.

How to use the code:
1. Copy the sample code that you want to use
2. Open the workbook in which you want to add the code
3. Hold the Alt key and press the F11 key to open the Visual Basic Editor (VBE)
4. Choose menu Insert | Module
5. Where the cursor is flashing, choose menu Edit | Paste
6. Hold the Alt key and press the Q key to leave VBE
7. Hold the Alt key and press the F8 key to display the Run Macro Dialog.
8. Double Click the macro's name to Run it


----------



## aarondesin91

Dear ZVI,

I would like to ask another help. In your code, given the mail is send automatically right. Is it possible that all the title and the body and the attachment is send to outlook but the last step which is clicking the send button is done manually meaning that when i run this code, the mail is all ready just waiting for the user to click the send button. another thing that is it possible to make the pdf file saved in the user pc at the desktop. and the "title" ( data captured from the cell) to be a part of the email title. For example, "Request Form for _Title_".Plus can the title be used at the name of the pdf file that been saved in the user's pc. please help me man.. would really appreciate your help.

Thanks alot


----------



## Michael M

Regardless of which code you use, change this line


		Code:
__


.Send

TO


		Code:
__


.Display


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## aarondesin91

Thank alot michael...How about the others in my reply above. could you help me??


----------



## Michael M

Which code are you using ??


----------



## aarondesin91

I am using the ZVI's code because i dont have acrobat to use your code.


----------



## Michael M

Maybe this then


		Code:
__


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long, DesktopPath As String
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
     ' Not sure for what the Title is
  Title = "Request Form for " & Range("A1").Value

  
  Set WSHShell = CreateObject("WScript.Shell")
    DesktopPath = WSHShell.SpecialFolders("Desktop")
    Set WSHShell = Nothing

    ThisWorkbook.SaveAs Filename:=DesktopPath & "\" & Title, FileFormat:=xlOpenXMLWorkbookMacroEnabled

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send or Display
    On Error Resume Next
    .Display
    '.Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## aarondesin91

hey bro,

I have some problem with the code you gave. When I run the code it say "Compile Error..Variable not defined"..Highlighted blue on "WSHShell" and highlighted yellow on "Sub AttachActiveSheetPDF()". How do i solve this bro??

Thanks in advantance


----------



## ZVI

Try this:


		Rich (BB code):
__


Sub AttachActiveSheetPDF_01()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A1")
 
  ' Define PDF filename
  Title = "Request Form for " & Range("A1").Value
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"
 
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "See the attached requiest in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    Application.Visible = True
    .Display
  End With
 
  ' Quit Outlook if it was not already open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## Michael M

and remove these lines



		Code:
__


' Not sure for what the Title is
  Title = Range("A1")


----------



## ZVI

Michael M said:


> and remove these lines


It's true, thank you Michael!


----------



## Michael M

No worries, thanks for correcting the other lines...ray:


----------



## audrey

Hello, this is a great code! thanks for sharing. Is it possible to return to the Outlook screen after clicking the button ? it is a little confusing to say email is sent, but it is actually outstanding as a draft.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## Michael M

Change the line of code that is


		Code:
__


.Send

AND REPLACE it with 


.Display


----------



## jsgaggio

New to the forum - what is the syntax for 2003


----------



## Michael M

Hi and welcome to the Forum, but in future please start a new thread, if you have a question.
To naswer your current question, the code will work in 2003


----------



## ZVI

jsgaggio said:


> what is the syntax for 2003


See Michael's code in post #2 and the top 2 lines of my comments in post #4


----------



## gopipallan

aarondesin91 said:


> Dear ZVI,
> 
> Please help me to convert excel chart into pdf file by using macro .


----------



## ZVI

gopipallan said:


> Dear ZVI,
> 
> Please help me to convert excel chart into pdf file by using macro .


Hi, 
Create chart on a sheet, save workbook in any folder and use the below code to export active sheet to the PDF file.


		Rich (BB code):
__


Sub SheetToPdf()
  Dim PdfFile As String
  
  ' Check compatibility of Excel version
  If Val(Application.Version) < 12 Then
    MsgBox "Export to PDF requires Excel 2007+", vbExclamation, "SheetToPdf"
    Exit Sub
  End If
  
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".xlsm", "") & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Report
   MsgBox "PDF file:" & vbLf & PdfFile, vbInformation, "SheetToPdf"
 
End Sub

Regards,


----------



## gopipallan

Thank You for your prompt response.

but still no luck i'm getting an error of invalid argument on below line

    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Thanks & regards

Raja pallan



ZVI said:


> Hi,
> Create chart on a sheet, save workbook in any folder and use the below code to export active sheet to the PDF file.
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub SheetToPdf()
> Dim PdfFile As String
> 
> ' Check compatibility of Excel version
> If Val(Application.Version) < 12 Then
> MsgBox "Export to PDF requires Excel 2007+", vbExclamation, "SheetToPdf"
> Exit Sub
> End If
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".xlsm", "") & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Report
> MsgBox "PDF file:" & vbLf & PdfFile, vbInformation, "SheetToPdf"
> 
> End Sub
> 
> Regards,


----------



## Michael M

You are using Excel 2007 or higher ???


----------



## gopipallan

Michael M said:


> You are using Excel 2007 or higher ???



Hi,

I am using excel 2007.


Thanks !!!!!!!!


----------



## Michael M

Try this one, using the old .xls file extension


		Code:
__


Sub SheetToPdf()
  Dim PdfFile As String
  
  ' Check compatibility of Excel version
  If Val(Application.Version) < 12 Then
    MsgBox "Export to PDF requires Excel 2007+", vbExclamation, "SheetToPdf"
    Exit Sub
  End If
  
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".xls", "") & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Report
   MsgBox "PDF file:" & vbLf & PdfFile, vbInformation, "SheetToPdf"
 
End Sub


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

Mat be workbook's name of sheet's name includes some of thе symbols which can't be used if filename: *?  "  /  \  <  >  *  |  :*
Try using ASCII symbols instead.


----------



## ZVI

This code will fix illegal symbols in PDF file name


		Rich (BB code):
__


Sub SheetToPdf1()
  Dim PdfFile As String, char As Variant, i As Long
  
  ' Check compatibility of Excel version
  If Val(Application.Version) < 12 Then
    MsgBox "Export to PDF requires Excel 2007+", vbExclamation, "SheetToPdf"
    Exit Sub
  End If
  
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = ActiveWorkbook.Path & "\" & PdfFile & "_" & ActiveSheet.Name
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(PdfFile, 251) & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Report
  MsgBox "PDF file:" & vbLf & PdfFile, vbInformation, "SheetToPdf"
 
End Sub


----------



## sclasen24

I need for the title to use the word PU: and then today's date?  Also I need for it to include multiple worksheets, Dec, Jan & Feb


----------



## NARAYANAPRASAD

Good Day!

I was looking at the above mentioned thread.
Copied and pasted the code provided.... but when i try to run the macro....
I get publishing screen and run through
But, get message saying "E-mail was not sent"
Please help


----------



## ZVI

NARAYANAPRASAD said:


> Good Day!
> 
> I was looking at the above mentioned thread.
> Copied and pasted the code provided.... but when i try to run the macro....
> I get publishing screen and run through
> But, get message saying "E-mail was not sent"
> Please help


Hi and welcome aboard!
For Excel 2007 firstly make sure this AddIn is installed - 2007 Microsoft Office Add-in: Microsoft Save as PDF or XPS
 Then try this safer (see the part in bold) version of the code:


		Rich (BB code):
__


Sub AttachActiveSheetPDF_01()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim char As Variant
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Change to suit
  'Title = Range("A1") & " " & Date
  Title = "PU: " & Date
 
  *' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(ActiveWorkbook.Path & "\" & PdfFile, 251) & ".pdf"*
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
  
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
  
    ' Try to send
    On Error Resume Next
    *.Display*  ' or use *.Send*
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
  
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub

Regards


----------



## NARAYANAPRASAD

Thank you so much for quick reply.  Its working.
with .Display, its attaching the file and keeping mail ready to send.
But, when i try to change from .Display to .Send it showing me the message E-mail successfully sent but really not sending the mail.  Is there anything which needs to be added as add-in?


----------



## ZVI

No other AddIns are required in case it is working with .Display 
But sending e-mail programmatically with Microsoft Office Outlook generates security warnings for the user and waits for manual confirming of sending.
Read more details in this link - Avoiding Excessive Security Warnings when Sending Automated E-mail Messages 
To be sure warning message takes a focus try to comment this line: Application.Visible = True

P.S. Please delete this atavistic line of the code: OutlApp.Visible = True


----------



## NARAYANAPRASAD

No sir, its not working. 
I can go with .Display works perfectly fine for me.  But wanted to just understand what needs to be done if i need to use .Send.
Thank You again Sir.


----------



## ZVI

No way to help without facing with that issue - .Send works well on my PC.
 So, just common suggestions:
1. Try to run the code on another PC to compare behavior
2. Pay your attention on Outlook's version - Microsoft Outlook Express is limited relative to Microsoft Outlook and may not work properly.
3. Play with settings of antivirus


----------



## micfly

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



Trying this code I get an error: "Run-time error '1004' Document not saved. The document may open, or an error may have been encountered when saving."

Debug highlights this line:  
	
	
	
	
	
	




		Rich (BB code):
__


.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


What is wrong? excell 2007


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

micfly said:


> What is wrong? excell 2007


Hi Micfly,

In post #36 it was highlighted that for Excel 2007 this Add-In have to be installed - 2007 Microsoft Office Add-in: Microsoft Save as PDF or XPS.
Please check it up or try its (re)installing.

Regards


----------



## micfly

Still getting the error. Perhaps a seperate problem? Could be due to anti-virus software on my PC but it's my work PC so I can't access those settings.


----------



## ZVI

micfly said:


> Still getting the error. Perhaps a seperate problem? Could be due to anti-virus software on my PC but it's my work PC so I can't access those settings.


Here is the list of some possible reasons of that kind of issue:

1. 2007 Microsoft Office Add-in: Microsoft Save as PDF or XPS is not installed.
This is not your case as you have already checked it out.

2. There is a symbol in the sheet name which is not allowed for the file name.
Code of post#36 solves this problem

3. Restricted permission for the file saving on desktop.
Try to save PDF manually to the same folder where your workbook is stored to see if it is possible. 
Moving workbook to the folder outside of the desktop can solve this issue.

  4. There can be influence of anti-virus software. Firewall software also can turn Excel to the sandbox mode.
Contact with administrator of your PC to eliminate these types of problems.

*The below code solves issues 2 and 3, give it a try*:


		Rich (BB code):
__


Sub AttachActiveSheetPDF_02()
 
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Change to suit
  'Title = Range("A1") & " " & Date
  Title = "PU: " & Date
 
  ' Define PDF filename in TEMP folder
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Delete PDF file - for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Export activesheet as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    '.To = "..." ' <-- Put email of the recipient here
    '.CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF file" & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send ' or use .Display
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
 
End Sub


----------



## micfly

Okay, thanks for the help, I'll keep working on it.


----------



## gajump

thanks for sharing thoese codes to convert excel to pdf, here is what i find out about this conversion progress.

// Render Excel to get a REImage collection, or choose specific page to render
BasePage XLSXDocument.GetPage(int pageIndex);
BaseImage XLSXPage.toImage();
BaseImage XLSXPage.toImage(int height, int width);

//Render Excel to desired document image format 
void REFile.SaveImageFile(REImage image, String filePath);
hope it is helpful. 
</pre>


----------



## chococ

Hi ZVI,

Thank you so much for sharing such helpful code with us. Can I ask if it can be modified to select multiple sheets and exported into multiple pdf in multiple emails respectively? I can stop it at the .Display stage so I can manually modify email body. The name of sheets can be manually coded into macro, they are known names and won't change. For convenience can just use Sheet1 Sheet2 Sheet3 for now, but I have 11 sheets in total.

At the moment I can run the macro separately on each sheet, but it will involve manually changing the recipients list inside the macro and if possible I would like to draw that list from a pre-made table as well.

Thank you very much in advance.

Bests


----------



## gregsilvers

Just tried this myself and it works great! Is there anyway to include a standard signature i,ve already set in outlook please? (instead of regards, user name)


----------



## AntExcel

Hi ZVI,

I tried your code BUT when it gets to .Attachements.add I get "Cant find file" error message. So then  decided to add a file path:

 ENVIRON("USERPROFILE") & "\Desktop" & PdfFile

IT WORKS! BUT in the file name I see DesktopExcelSheet.pdf

I tried many situations and now very annoyed, can you help???

Thank you.

Ants


----------



## AntExcel

Nevrmind jutsaw your latst post.

Thanks works great!



AntExcel said:


> Hi ZVI,
> 
> I tried your code BUT when it gets to .Attachements.add I get "Cant find file" error message. So then  decided to add a file path:
> 
> ENVIRON("USERPROFILE") & "\Desktop" & PdfFile
> 
> IT WORKS! BUT in the file name I see DesktopExcelSheet.pdf
> 
> I tried many situations and now very annoyed, can you help???
> 
> Thank you.
> 
> Ants


----------



## lapot

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



How do I change this code for a Word Document, I have a Word Document on my desktop and I like to convert and attach it to Outlook? Here is the location C:\Users\Admin\Desktop


Regards


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

lapot said:


> How do I change this code for a Word Document, I have a Word Document on my desktop and I like to convert and attach it to Outlook? Here is the location C:\Users\Admin\Desktop


 The previous code was for storing in VBA module of Excel’s workbook, add-in or personal workbook. 
  So, where the code for WinWord have to be stored and run from?


----------



## lapot

Thanks for your reply but I have an excel report which has Sql invoices locations on column D. I was hoping to start the invoice from that location then convert to PDF and attach it to outlook. My invoices are in word format. Basically I like this code run from excel sheet and start word document then convert PDF before attaching it to an email. Is it possible?


----------



## ZVI

Well, try this:  


		Rich (BB code):
__


Sub AttachActiveSheetPDF_03()
' Copy this code to the module of any Excel's workbook.
' Prepare report/invoice in MyReport.doc or MyReport.docx and store it on Desktop
' This macro exports the report document to PDF and attaches that PDF to Outlook's email
 
  Dim IsOutlCreated As Boolean, IsWordCreated As Boolean, IsDocOpen As Boolean
  Dim DesktopPath As String, DocFile As String, PdfFile As String, Title As String, s As String
  Dim OutlApp As Object, WordApp As Object
  Dim i As Long
  Dim char As Variant
  Const wdExportFormatPDF = 17
 
  ' --> Settings, change to suit
  Const WordDocument = "MyReport.doc"
  'Title = Range("A1") & " " & Date
  Title = "PU: " & Date
  ' <-- End ofsettings
 
  ' Check WordDocument presence on Desktop
  DesktopPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
  DocFile = DesktopPath & "\" & WordDocument
  s = Dir(DocFile & "*")
  If s = "" Then
    MsgBox "Word Report file not found:" & vbLf & DocFile, vbExclamation, "Exit"
    Exit Sub
  End If
  DocFile = DesktopPath & "\" & s
 
  ' Define PDF filename in TEMP folder
  PdfFile = WordDocument
  i = InStrRev(PdfFile, ".", , vbTextCompare)
  If i > Len(PdfFile) - 6 Then PdfFile = Left(PdfFile, i - 1)
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Delete PDF file - for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Open WordDocument if it was not open previously
  On Error Resume Next
  Set WordApp = GetObject(, "Word.Application")
  If Err Then
    Set WordApp = CreateObject("Word.Application")
    IsWordCreated = True
  End If
  Err.Clear
  WordApp.ScreenUpdating = False
  With WordApp.Documents(s): End With
  IsDocOpen = Err = 0
  On Error GoTo 0 'exit_
  If Not IsDocOpen Then
    WordApp.Documents.Open Filename:=DocFile, ReadOnly:=IsWordCreated
  End If
 
  ' Export activedocument as PDF to the temporary folder
  WordApp.Documents(s).ExportAsFixedFormat OutputFileName:=PdfFile, ExportFormat:=wdExportFormatPDF
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsOutlCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    '.To = "..." ' <-- Put email of the recipient here
    '.CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The invoice is attached in PDF file" & vbLf & vbLf _
          & "Best Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send ' or use .Display
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
 
  End With
 
exit_:
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Close WordDocument if it was open via this macro
  If IsDocOpen Then
    WordApp.Documents(s).Close False
  Else
    WordApp.ScreenUpdating = True
  End If
 
  ' Close WordApp if it was open via this macro
  If IsWordCreated Then WordApp.Quit: Set WordApp = Nothing
 
  ' Try to quit Outlook if it was not previously open
  If IsOutlCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
 
  If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number
 
End Sub


----------



## Wiss3

Hello Guys,

Am new to this forum. Thank you for the VBA code.
Would someone be able to help with this? Instead of typing the recipient's email address in the code, i want the macro to lookup a list/cell within the same workbook and fetch the email address automatically (where i will have changing recipient addresses based on content changes).

Appreciate your help.

Wiss


----------



## ZVI

Wiss3 said:


> ... Instead of typing the recipient's email address in the code, i want the macro to lookup a list/cell within the same workbook and fetch the email address automatically (where i will have changing recipient addresses based on content changes).


Hi and welcome to MrExcel Message Board!

Uncomment the line of code with .To = "..."
and write it something like this:  .To = Range("A1").Value
or: .To = ActiveCell.Value
 or for 2 recipients in cells A1:A2: .To = Range("A1").Value & ";" & Range("A2").Value
and so on

Regards,


----------



## Wiss3

Thank you Vlad!


----------



## Sweety sweety

Hi,

I am working on the similar project as well.
But I continuously have the same problem.
The problem is when the excel sheet attachment final seperate out from it , I am unable to open the attachment. 
I found out that the size of the attachment have reduce a lot but not sure what is the root cause. 
The error message is :  There was an error opening this document. The root object is missing or invalid. 

For example:
I attach a pdf file in the excel sheet. The original size of the pdf is 48 KB. When it final confirm, the pdf attachment will seperate out, but the file size reduce to 4 KB. 

Anyone know how to solve it ?

Thank you.


----------



## zeheckman

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



how would i take this code, and use it to email only select sheets using check boxes on the user form this code is tied to the button click on?

for example, i have 4 check boxes on the userform. i check one of them to add sheet 1 only, and then click the command button send email. can this code be tied to that check box to only send sheet 1 as a pdf?


----------



## ZVI

zeheckman said:


> for example, i have 4 check boxes on the userform. i check one of them to add sheet 1 only, and then click the command button send email. can this code be tied to that check box to only send sheet 1 as a pdf?


That code if for attaching of active sheet only
You can activate the required sheet and sent it like this:


		Rich (BB code):
__


  If CheckBox*2*.Value = True Then
    Sheets(*2*).Activate
    Call AttachActiveSheetPDF
  End If


----------



## zeheckman

ZVI said:


> That code if for attaching of active sheet only
> You can activate the required sheet and sent it like this:
> 
> 
> Rich (BB code):
> __
> 
> 
> If CheckBox*2*.Value = True Then
> Sheets(*2*).Activate
> Call AttachActiveSheetPDF
> End If



10-4,

how would i combine that code with my email code on the command button click?

Command button click, 

im not quite sure what to take out of the code to add this line in.

im guessing something like this?



		Rich (BB code):
__


Private Sub CommandButton1_Click()

  If CheckBox*1*.Value = True Then     Sheets(1).Activate     Call AttachActiveSheetPDF   End If
  If CheckBox*2*.Value = True Then     Sheets(*2*).Activate     Call AttachActiveSheetPDF   End If
  If CheckBox*3*.Value = True Then     Sheets(*3*).Activate     Call AttachActiveSheetPDF   End If
  If CheckBox*4*.Value = True Then     Sheets(*4*).Activate     Call AttachActiveSheetPDF   End If

  ' Prepare e-mail with PDF attachment   With OutlApp.CreateItem(0)         ' Prepare e-mail     .Subject = Title     .To = "..." ' <-- Put email of the recipient here     .CC = "..." ' <-- Put email of 'copy to' recipient here     .Body = "Hi," & vbLf & vbLf _           & "The report is attached in PDF format." & vbLf & vbLf _           & "Regards," & vbLf _           & Application.UserName & vbLf & vbLf     .Attachments.Add PdfFile         ' Try to send     On Error Resume Next     .Send     Application.Visible = True     If Err Then       MsgBox "E-mail was not sent", vbExclamation     Else       MsgBox "E-mail successfully sent", vbInformation     End If     On Error GoTo 0       End With     ' Delete PDF file   Kill PdfFile     ' Quit Outlook if it was created by this code   If IsCreated Then OutlApp.Quit     ' Release the memory of object variable   Set OutlApp = Nothing   End Sub



</pre>


</pre>


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## zeheckman

here is another example of what i am trying to do if possible. 

this one works, but adds EVERY active sheet in the excel doc.

i only want the 4 in my userform to be active only if selected by checbox. 




		Code:
__


Private Sub CommandButton1_Click()

    
ActiveWorkbook.Save

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = "Empire-Cat Rental Equpment Quote"
 
  ' Define PDF filename
  PdfFile = checkbox.Select
  i = InStrRev(PdfFile, "1")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "" & ".pdf"
    Wkbk = ActiveWorkbook.Path & "/" & ActiveWorkbook.Name
  ' Export activesheet as PDF
  With ThisWorkbook
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = TextBox4.Value
    .CC = TextBox1.Value
    .BCC = "Email Here" 'type any .bcc email here
    .Body = "Text." & vbLf & vbLf _
          & "Text email text " & Application.UserName & vbLf & vbLf & TextBox2.Value & vbLf & vbLf & vbLf _
          & "text email text" & vbLf _
          & "text email text" & vbLf & vbLf
        
    .Attachments.Add PdfFile
    
    x = TextBox3.Value
    If x <> "" Then
        Spx = Split(x, " ; ")
        For k = 0 To UBound(Spx)
            If Trim(Spx(k)) <> "" Then

                .Attachments.Add Trim(Spx(k))
            End If
        Next
    End If
      
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "Message NOT sent. Try again!", vbCritical
    Else
      MsgBox "Your Rental Quote Has Been Sent To " & TextBox4.Value, vbOKOnly
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 Unload Me
End Sub


----------



## ZVI

Put the below code into UserForm's module, replace in the code "Sheet1" ... "Sheet4" by actual names of the sheets and try.
It is assumed that CheckBox1 ... CheckBox4 and CommandButton1 are on the form.


		Rich (BB code):
__


' Put the below code into the module of userform
' with CheckBox1 ... CheckBox4 and CommandButton1
 
Private Sub CommandButton1_Click()
 
  Dim MySheets As String
 
  ' --> Use names of the real sheets instead of the below "Sheet1", ... ,"Sheet4"
  If CheckBox*1* Then MySheets = "*Sheet1*"
  If CheckBox*2* Then MySheets = MySheets & ",*Sheet2*"
  If CheckBox*3* Then MySheets = MySheets & ",*Sheet3*"
  If CheckBox*4* Then MySheets = MySheets & ",*Sheet4*"
  ' <--
 
  ' Select sheets to be exported to the PDF file
  If Left(MySheets, 1) = "," Then MySheets = Mid(MySheets, 2)
  ActiveWorkbook.Sheets(Split(MySheets, ",")).Select
 
  ' Email as PDF the selected sheets
  Call AttachActiveSheetPDF_04
 
  ' Close the form
  Unload Me
 
End Sub
 
Sub AttachActiveSheetPDF_04()
  ' This sends email with attached PDF file of the selected sheets
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim i As Long
  Dim Char As Variant, Attachment As Variant
 
  ' Change to suit
  Title = "Empire-Cat Rental Equpment Quote"
 
  ' Define PDF filename in TEMP folder
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
  For Each Char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, Char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
 
  ' Delete PDF file - for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Export the selected sheets of workbook as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
 
    ' Prepare e-mail
    .Subject = Title
    '.To = TextBox4.Value    ' Email(s) of the main recipient(s)
    '.CC = TextBox1.Value    ' Email(s) of 'copy to' recipient(s) (CC = "Carbon Copy")
    '.BCC = TextBox9.Value   ' Email(s) of hidden recipient(s) (BCC = "Blind Carbon Copy")
    .Body = "Dear Customer," & vbLf & vbLf _
          & Title & " is attached in PDF file" & vbLf & vbLf _
          & "Best Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
 
    ' Add other attachments here
    'For Each Attachment In Split(TextBox3.Value, ";")
    '  If Trim(Attachment) <> "" Then .Attachments.Add Trim(Attachment)
    'Next
 
    ' Try to send
    On Error Resume Next
    .Send  ' or use .Display
 
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
 
End Sub


----------



## ZVI

You may also add: If CheckBox1 + CheckBox2 + CheckBox3 + CheckBox4 = 0 Then Exit Sub


----------



## zeheckman

Thank you!

This works perfectly!! Exactly what I was looking for!


----------



## ZVI

zeheckman said:


> Thank you!
> 
> This works perfectly!! Exactly what I was looking for!


Glad it helped and thanks for the feedback!


----------



## steve21a

ZVI, I would like to use your code from page 1 of this thread but I would need the code to work for a group mailbox in Lotus Notes 8.5.  I would need the code to pick the group mailbox as opposed to the personal inbox.   Any ideas?


----------



## Nelsonpk

First of all let me thank you for this code. I am using it so a form I created in excel can be generated as a pdf and emailed and it works faultlessly. Is it possible for the code to incorporate a feature extending the rights in the pdf so the receiver can digitally sign it, or is this something that can only be done by Adobe Pro?

Many thanks


----------



## shauncasey

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



If I wanted the code to just generate the email and allow me to enter the email address and email body, what would I need to change?

Thanks in advance.


----------



## shauncasey

Ignore the above, I missed a page of the thread with the solution to the above


----------



## kris77

Hello ZVI,

I'm new to the forum. 

Would you mind to help with adding additional code to the below. I need data in column A to be sorted by supplier name and then copied to seperate sheets, then individally converted into PDF files and saved with column A name and today's date and then send seperately to different email addressess depending of column A.

Please note: Supplier names in the column A will change depence of a date, report will be run every day and data send for previous day only. Column B: it's a date.

thanks so much!



ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## kapilsum

Hi Michael 
Thanks for all the information i have tried the code and it works perfectly; except on small issue  the PDF file generated is not in a single page.
So the scenario is have one worksheet and it is an invoice but when code converts the file to PDF it is broken into 2 pages of a single PDF file . so out of 7 rows and columns 3 are written on the first page and the rest 4 on the second page.
I am not sure what wrong i am doing , Please i will thankful if you can help me to sort this out.

Thanks
SK


----------



## suparson

Sorry if I'm doing this wrong not sure why I can not open a new thread

I have set up a macro to save an excel file as pdf and send it but I now want to be able to send with this a further pdf from a file path and cell pointer can you help me?


----------



## bill1967

I am trying to do something similar but instead of trying to convert my Excel to a PDF, I and trying simply email a single sheet from the workbook. I have code that I found online that I have altered to almost work. It does what it is supposed to do but because the sheet has linked cells the links are in the emailed copy. I would like to get it to some how be text only by possibly doing a paste as values or something along those lines. Below is the script I have so far.


Sub Email_Worksheet_Only()

Dim oApp As Object
    Dim oMail As Object
    Dim WB As Workbook
    Dim FileName As String
    Dim wSht As Worksheet
    Dim shtName As String

    Application.ScreenUpdating = False

    ' Make a copy of the active worksheet
    ' and save it to a temporary file
    ActiveSheet.Copy
    Set WB = ActiveWorkbook

    FileName = WB.Worksheets(1).Name
    On Error Resume Next
    Kill "C:\" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:="H:\CCC Business & Reports\CCC Reports\2015 CCC Reports\QC_Evaluation_Form.xlsx"

    'Create and show the Outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        'Uncomment the line below to hard code a recipient
        .To = "phelpsb@grangeinsurance.com"
        'Uncomment the line below to hard code a subject
        .Subject = "QC Evaluation Form Email Test"
        'Uncomment the lines below to hard code a body
        .body = "This is a test email"
        .Attachments.Add WB.FullName
        .Display
    End With

    'Delete the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False

    'Restore screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing

End Sub


----------



## abbasi82

Hello zvi,

i followed above code as per your instruction, but didn't success.

Error:

  Compile Error:
  Expected End Sub

Please Help....


----------



## ZVI

abbasi82 said:


> Compile Error:
> Expected End Sub


Hi,

This means that the code was not completely copied from here into your VBA module.
Please select full contents of the code before copying, the last copied line of the code have to be *End Sub*

Regards


----------



## Onsmaram

Hello ZVI,

First of all, please forgive my bad English.

Thank you very much for this very nice code. I'm trying to adapt it for my own purpose. 
I'm very new with VBA coding and need help.

I'm trying to find a way on how I can have a treeview with checkbox to be able to select one or many files (pdf, doc, xls ....) and to attach them to an email directly from my excel workbook.

Can you please help me with this?

Regards


----------



## Stocktaker

Hi Everyone

Just wanted to say a huge Thanks to ZVI  and Michael M, I pick up this thread and used the code from ZVI  in page 2 

Works an absolute dream form me in excel 2010  with Microsoft Outlook.  I just need remote user's to test my Order form next.

Many Thanks Again.

The Stock taker


----------



## bill1967

I used the same one and got it to work for me as well. I had to make a couple tweaks to suit my needs but it is a great piece of code.


----------



## MilkyTech

*convert worksheet to pdf, save, and attach to email*

OK, I've gotten this to work really well with the code below, including saving the pdf to the same location as the workbook.  Problem is that my solution seems klunky in that I am attaching the temp pdf file to the email and saving a completely separate pdf file.  I would rather just save and attach the same file.  I tried just deleting the code that deletes the temp pdf file and then added ThisWorkbook.Path to the export code like this: 
	
	
	
	
	
	




		Code:
__


With ActiveSheet    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

 but that didn't work; it produces a run-time error and the file doesn't save.  So this is what I ended up doing using moslty the code from the post on page 5 of this thread):




		Code:
__


Private Sub CommandButton2_Click()
 
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Change to suit
  'Title = Range("A1") & " " & Date
  Title = "INVOICE " & ActiveSheet.Range("G15").Value
 
  ' Define PDF filename in TEMP folder
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = Title
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Export activesheet as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & "INVOICE " & ActiveSheet.Range("G15").Value, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  End With
  
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = ActiveSheet.Range("A13").Value ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi " & ActiveSheet.Range("A12").Value & "," & vbLf & vbLf _
          & "Your invoice is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf & vbLf _
          & "My Company" & vbLf & "www.MyCompany.com" & vbLf & "xxx-xxx-xxxx" & vbLf
    .Attachments.Add PdfFile
   
    ' Display email
    On Error Resume Next
    .Display ' or use .Send
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
 
  End With
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
  
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
 
End Sub

How do I simply attach my second "With ActiveSheet" command which saves the pdf where I want instead of the first one (the temp file)?


----------



## MilkyTech

*Re: convert worksheet to pdf, save, and attach to email*

So my question that I should have put in the post above is, How can I simply attach the file created in the second export command which saves the pdf where i want it, rather than the first export command that is in the temp directory?


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## mick0005

*Re: convert worksheet to pdf, save, and attach to email*

Wanted to thank all of the contributors of this thread!  I was able to take bits and pieced to help accomplish something I needed.  Thanks again!


----------



## MilkyTech

*Re: convert worksheet to pdf, save, and attach to email*

This works great for me since I use Outlook on Windows, but my boss is on a MAC.  Can this be easily modified for the OS X email client?  Or better yet, be modified for whatever the default mail client may be?
Also, I am still hoping someone can answer my question from Posts #80/#81.


----------



## gcriger

*Re: convert worksheet to pdf, save, and attach to email*

What you have put already has been amazing. But I am trying to send a sheet as a PDF and wanting it not to just send as an attachment but as soon as you open the email it will show up. Can I just send the excel sheet as a PDF that way or will it have to be as an attachment?


----------



## MilkyTech

*Re: convert worksheet to pdf, save, and attach to email*



gcriger said:


> What you have put already has been amazing. But I am trying to send a sheet as a PDF and wanting it not to just send as an attachment but as soon as you open the email it will show up. Can I just send the excel sheet as a PDF that way or will it have to be as an attachment?


I don't believe you can do exactly what you are asking. You cannot have a pdf in the body of an email.  You can copy data from the pdf and paste it in the body, but it will lose formatting.

It would depend on the email client of the person opening the email whether or not a pdf _attachment_ will be previewed.  I know mac mail will automatically preview pdf attachments.  With outlook, even if you have the correct selection for previewing pdf's, you still need to click on the attachment to preview it.

Instead, this code below I threw together is a combination of ZVI's, Ron de Bruin's, byundt's, and some of my own.  It will:

Save a pdf of the "Print Area" to the same folder the workbook is saved in
Attach a copy of the pdf to an Outlook email
Copy the current _selection_ from the worksheet to the body of the email (this is the part you are looking for, unfortunately does not copy images such as a company logo)
Open the pdf (change _OpenAfterPublish:True_ to False if you dont want this step)
Display the email for review before sending
You can customize this anyhow you like:


		Code:
__


Sub pdfAndEmail()    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim RngCopied As Range
    Dim IsCreated As Boolean
    Dim PdfFile As String, Title As String
    Dim i As Long
    Dim char As Variant


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    Set RngCopied = Selection
    
     ' Change to suit
  'Title = Range("A1") & " " & Date
  Title = ActiveSheet.Range("B11").Value & " Submittal"
 
  ' Define PDF filename in TEMP folder
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = Title
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Export activesheet as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  End With
  
    'On Error Resume Next
    With OutMail
        .To = "johndoe@gmail.com" ' Either an email address or a cell value that contains an email address: ActiveSheet.Range("B11").Value
        .CC = ""
        .BCC = ""
        .Subject = ""
        .HTMLBody = RangetoHTML(RngCopied)
        .Display  ' Change this to Send if you want to automatically send it without preview
        .Attachments.Add PdfFile  ' Delete this line if you don't want the attachment
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub



Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function


----------



## brownmonkey

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



Hi ZVI,

Would you be able to help with the following in relation to the above code?

How do I get the colours to also transfer? there are some figures/words in red (the rest is black font) that are transferring to pdf in black using the above code.

Thanks in advance for your assistance


----------



## wonderfulcow

Thank you so much for providing this code. It worked for me (with the Title- Range ("A2") - i was able to export a form and it was opened as an attachment in the email.

however, when I ask my brother to try to file - he got a different result
(he's also using Excel 2010). After he clicked on the Button (where i attached the module), Excel prompt him to select a printer (and ADOBE PDF is one of the option), after he selected the Printer (and) the Adobe PDF the second time, he got an Run Time error message. 

Any suggestions on how to make this work?




ZVI said:


> Try this:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF_01()
> Dim IsCreated As Boolean
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> Title = "Request Form for " & Range("A1").Value
> PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"
> 
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "See the attached requiest in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> Application.Visible = True
> .Display
> End With
> 
> ' Quit Outlook if it was not already open
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


----------



## geranuno

Thank you for Sharing Vladimir (ZVI)


----------



## MilkyTech

> when I ask my brother to try to file - he got a different result


When he gets the runtime error, have him click on "debug" to see what line in the code is causing the error.
You can try this code that I use. It will save the pdf to the same folder as the excel doc before attaching it to the email. The comments should explain everything that the code is doing.  If this works for you and not your brother then I would venture to guess that his computer is not configured properly for the code to work.
	
	
	
	
	
	




		Code:
__


Sub ConvertAttachPDF()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String, signature As String
  Dim OutlApp As Object 
 
  Title = Range("B9")      ' Change or eliminate to suit your needs.  I use this value only for filling out the subject line of the email.

' Set pdf filename and path to folder where excel doc is currently saved
    With ThisWorkbook
    PdfFile = .Path & Application.PathSeparator & _
              .Sheets("Current Sheet Name Here").Range("B9") & ".pdf"   ' I am using the value of cell B9 for my filename.
    End With
 
' Export activesheet as PDF to the current folder  
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True   ' Change this to False if you don't want to preview the created pdf
  End With
  
 
    
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    .Display         ' We need to display the email first for the signature to be added
    .Subject = Title
    .To = ActiveSheet.Range("E10").Value ' <-- Put email of the recipient here
    .CC = "anyone@abc.com; someone@abc.com" ' <-- Put email of 'copy to' recipients here
    .Body = "Blah blah blah blah blah." & _
        vbNewLine & vbNewLine & _
        "Thank you," & _
        .Body      ' Adds default signature
    .Attachments.Add PdfFile   
   
    On Error Resume Next
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
    End If
    On Error GoTo 0
 
  End With 
  
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
End Sub


----------



## clrprnstdngr

When I run this macro and Outlook is open everything works great.  When Outlook is not open it still creates the email but the attachment does not get added and when i switch back to Excel I get this runtime error.






When I debug it references attachments.add PdfFile.  Here is my code.



		Code:
__


Sub EmailPDFtoDealer()  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object


 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = "Weekly Performance Review " & Date & " - " & ActiveSheet.Range("C3").Value
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(PdfFile, 251) & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat To:=1, Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
    OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Display
    .Subject = "Weekly Performance Review " & Date & ":  " & Range("C3")
    .To = ActiveSheet.Range("$R$6") ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello " & ActiveSheet.Range("C3").Value & "," & vbLf & vbLf _
          & "Your Weekly Performance Review is attached in PDF format." & vbLf & vbLf & _
          .Body
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## MilkyTech

> clrprnstdng


You don't want to save your own copy of the pdf?  you only want to attach it, then delete the temp file?


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## clrprnstdngr

MilkyTech said:


> You don't want to save your own copy of the pdf?  you only want to attach it, then delete the temp file?



I don't need to keep a copy for myself.  If I have to to get it to work that's fine.  All of this code is cobbled together mostly from this thread and a few other details from other places so if you can show me exactly what needs to be added or removed I would be grateful.


----------



## MilkyTech

clrprnstdngr said:


> I don't need to keep a copy for myself.  If I have to to get it to work that's fine.  All of this code is cobbled together mostly from this thread and a few other details from other places so if you can show me exactly what needs to be added or removed I would be grateful.



You haven't defined a path for the temp file, so when the code tries to attach the file it can't find it.

Change the line after `Next` to:


		Code:
__


Next
   PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"


----------



## danelskibr

ZVI,

I know it has been a while since you have been on this thread, but I am wondering if you could supply the code needed to format the PDF as follows:

1) A selected range of (A1:E100)
2) Fit colums on one page

Thanks for the help!

Also, is there a way to use the Outlook defined signature rather than an excel defined signature?


----------



## MilkyTech

danelskibr said:


> ...code needed to format the PDF as follows:
> 1) A selected range of (A1:E100)
> 2) Fit colums on one page
> Also, is there a way to use the Outlook defined signature rather than an excel defined signature?



This code should do just about everything you want plus a lot more.  There are a couple of options:  You can either manually select the cells that you want printed to pdf or, if the range is always going to be the same, we can set that range.  
For this example I have set the range to be printed to pdf but we will also be able to place a manually selected range in the body of the email.  All in all this code will:



Print a set range of cells to pdf and fit columns to 1 page width
Name and save the pdf to the same folder that the excel file resides (we can make this a temp folder then delete the file after attaching if you don't want to save your own copy)
Fill out a new email using the default outlook account
Add the manually selected range of cells to the body of the email
Attach the pdf to the email
Add the default outlook account's signature



		Code:
__


Sub printSelection()  
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String, signature As String
  Dim OutlApp As Object
  Dim RngCopied As Range


  Set RngCopied = Selection
 
  ' Here we define the pdf path and filename
  Title = Range("B11") & " PROPOSAL" ' I only use this line to help fill out the email subject.  It is not necessary
    With ThisWorkbook
    PdfFile = .Path & Application.PathSeparator & _
              .Sheets("Sheet1").Range("B11")
    End With
  
  With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .Zoom = False
  End With
  
  ' Export activesheet as PDF to the current folder
  With ActiveSheet
    Range("A1:E100").Select
    Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile & " Proposal.pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  End With
  
   With ThisWorkbook
    PdfFile = PdfFile & " Proposal.pdf"
    End With
    
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    .Display         ' We need to display email first for signature to be added
    .Subject = Title
    .To = ActiveSheet.Range("E10").Value ' <-- Put email of the recipient here or use a cell value
    .CC = "whoever@abc.com; copy@abc.com" ' <-- Put email of 'copy to' recipients here
    .HTMLBody = "Thank you for the opportunity to bid on the painting for " & ActiveSheet.Range("B9").Value & ". " & " Please read our attached proposal in it's entirety to be sure of all inclusions, exclusions, and products proposed.  Give us a call with any questions or concerns." & _
        vbNewLine & vbNewLine & _
        RangetoHTML(RngCopied) & _
        "Thank you," & _
        .HTMLBody      ' Adds default outlook account signature
    .Attachments.Add PdfFile
   
    
    On Error Resume Next
    
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
    ' MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
 
  End With
    
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
End Sub




Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function


----------



## clrprnstdngr

MilkyTech said:


> You haven't defined a path for the temp file, so when the code tries to attach the file it can't find it.
> 
> Change the line after `Next` to:
> 
> 
> Code:
> __
> 
> 
> Next
> PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"



Thanks Milky you rock!


----------



## ssibsm

ok..i have this question...and i dont know where to post it...I have a basic knowledge about excel and am trying to learn new things…need some help with this..Example:I have made a Time sheet in excel for John..as John is not tech with IT….in this time sheet I have added details,login,logout,formulas for calculating the total hours etc…so when John receives it he just have to put the login and logout timings and the remaining is calculated automatically…
so here is my question,1)can i email this active workbook as a body of the email(Not as attachment) to John??2)And when John receives the email he should be able to fill the sheets with timings in the active worksheet in the email itself and forward me back the same email.(No need to download,fill,attachment and send back headache for John)3)which mail supports this….I use outlook 2007…so I was just wondering is there any thing like this and Detailed Answer is much appreciated…Thanks in advance


----------



## MilkyTech

ssibsm said:


> ...1)can i email this active workbook as a body of the email(Not as attachment)


workbook or worksheet?  I'll assume you meant worksheet.  The code in post #95 will do that for you with a little manipulation.  It only works with outlook so you're good there.  It's well commented so should be easy for you to figure out.  Give it a shot and let me know how it went.


----------



## MilkyTech

ssibsm said:


> ...and Detailed Answer is much appreciated


This is what you should be shooting for.  If you really want to learn something and not just have someone else write your code for you, compare this code with the code in post #95 and take notice the changes I made. 
You can paypal donations to milkytech @ gmail . com 



		Code:
__


Sub pasteSelection()  
  Dim IsCreated As Boolean
  Dim Title As String, signature As String
  Dim OutlApp As Object
  Dim RngCopied As Range
 
  
  ' Select the range of cells you want pasted in the email body
  With ActiveSheet
    Range("A1:E100").Select
    Set RngCopied = Selection
  End With
  
  
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    .Display         ' We need to display email first for signature to be added
    .Subject = Title
    .To = ActiveSheet.Range("E10").Value ' <-- Put email of the recipient here or use a cell value
    .CC = "whoever@abc.com; copy@abc.com" ' <-- Put email of 'copy to' recipients here
    .HTMLBody = "Please reply to this email to be able to fill out the time sheet below:" & _
        vbNewLine & _
        RangetoHTML(RngCopied) & _
        "Thank you," & _
        .HTMLBody      ' Adds default outlook account signature
   
    
    On Error Resume Next
    
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
    End If
    On Error GoTo 0
 
  End With
    
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
End Sub




Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function


----------



## Dwalk

Hi, This is my first post to this Forum, and from what I've read it looks very helpful.  I am trying to do the same as the original poster, that is to save the file as a PDF and e-mail it to a set e-mail address.  I have put a button on my worksheet, and have got ZVI's code to work form page 2 to work.  However, when I run the macro, Outlook opens, with an e-mail ready to send the PDF,  BUT doesn't actually send the e-mail, outlook just asks" Do you want to save the changes"   What is going wrong?

Also I would like the code to create the PDF filename as "Order for" + reference cell C3 in worksheet (contains customer name) + todays date on the end.

No signature is required, and it would be best if this process runs in the background without user input.  Confirmation of the order having been sent would also be useful.

Please note that I have little to no experience with VBA, and I will need all the assistance you can spare.  My apologies and thanks, programming is not a strong-point of mine.

My computer is running excel 2013 and outlook 2013.

Thanks in advance for your help,

David


----------



## MilkyTech

Dwalk said:


> ...when I run the macro, Outlook opens, with an e-mail ready to send the PDF,  BUT doesn't actually send the e-mail, outlook just asks" Do you want to save the changes"   What is going wrong?
> 
> Also I would like the code to create the PDF filename as "Order for" + reference cell C3 in worksheet (contains customer name) + todays date on the end.
> 
> No signature is required, and it would be best if this process runs in the background without user input.  Confirmation of the order having been sent would also be useful.



What is happening is that ZVI's code on page 2 has a line of code that opens Outlook if it isn't already open, then the email is created, then the email is set to `.display` rather than `.send`, then finally there is a line of code that closes Outlook if it wasn't already open.  Because outlook is trying to close while still having an open email that hasn't been sent is why it is asking you to save.

You can solve this easily by switching `.display` to `.send`, then Outlook will immediately send the email as soon as it finishes filling it out.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## MilkyTech

As for the filename, you will need something like the following:


		Code:
__


Sub AttachActiveSheetPDF_02() 
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String, signature As String
  Dim OutlApp As Object
  Dim char As Variant
  Dim today As String
  
  
  today = Date
  today = Format(Date, "mm-dd-yyyy")
  
  ' Change to suit
  Title = "Order for " & Range("C3") & "_" & today

    With ThisWorkbook
    PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"
    End With
  
  
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  End With
  
    
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  With OutlApp.CreateItem(0)
   
    .Subject = "..."
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "See the attached requiest in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    Application.Visible = True
    .Send
    
    On Error Resume Next
   
    ' Return focus to Excel's window
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
    End If
    On Error GoTo 0
 
  End With
  
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  ' Note: sometimes Outlook object can't be released from the memory
  Set OutlApp = Nothing
End Sub


Just remember that this will save a copy of the pdf to your desktop.


----------



## aashwinjain

ZVI said:


> Hi and welcome to MrExcel Message Board!
> 
> Uncomment the line of code with .To = "..."
> and write it something like this:  .To = Range("A1").Value
> or: .To = ActiveCell.Value
> or for 2 recipients in cells A1:A2: .To = Range("A1").Value & ";" & Range("A2").Value
> and so on
> 
> Regards,




----------------------------------------------------------------------------------------------------------------------------------

Dear ZVI : thanx for sharing the wonderful code. Works for us perfectly well. We are trying to do a small modification and are stuck.

In the body section of the mail : We want the following :

Hi { name of the person stored in A1 cell }. Please find attached the pdf for your ref.

For the folllowing we did this modification but is not working. Please help

 .Subject = Title
    .To = Mail ' <-- Put email of the recipient here
    .CC = "info@flygoldfinch.com" ' <-- Put email of 'copy to' recipient here
    .Body = "*Hi "  ";" range("a1").value *": Please find attached the pdf for your ref," & vbLf & vbLf _
          & "See the attached requiest in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile


----------



## MilkyTech

aashwinjain said:


> ----------------------------------------------------------------------------------------------------------------------------------
> ...In the body section of the mail : We want the following :
> 
> Hi { name of the person stored in A1 cell }. Please find attached the pdf for your ref.



try this:



		Code:
__


[COLOR=#333333].Body = [SIZE=2][FONT=lucida sans unicode]"[/FONT][/SIZE][/COLOR][SIZE=2][FONT=lucida sans unicode][B]Hi " & Range("A1").Value & ".  Please find the attached pdf for your reference." & vbLf & vbLf _[/B][/FONT][/SIZE]


----------



## ajaydeepakson

Hey milky tech !! thanx for the previous revert.
Could you help us out with two more things ::

1. After i run this code on button click : I want to create pdf of a non active sheet and not the active sheet
2. How do i save the files on a specific folder/drive.
PS : We want tot save the file on one drive folder which is located on the d drive

Thanx for the update


----------



## michaelt721

Hi,

I tried this code and I get an error "Email not sent"

Any ideas?


----------



## mshaynerush

This code below names my pdf WORKBOOKNAME_Sheet Name
Can it just be the sheet name only??



ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


----------



## MilkyTech

mshaynerush said:


> This code below names my pdf WORKBOOKNAME_Sheet Name
> Can it just be the sheet name only??



you need to adjust this section:


		Rich (BB code):
__


_' Define PDF filename
__  PdfFile = ActiveWorkbook.FullName
__  i = InStrRev(PdfFile, ".")
__If__ i > 1 __Then__ PdfFile = Left(PdfFile, i - 1)
__  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"_

_
to read:
_


		Rich (BB code):
__


_' Define PDF filename
__PdfFile = ActiveSheet.Name & ".pdf"_


You can make the filename anything you want in this section


----------



## andyswin

Hi all,

The code below works perfectly for what I am trying to do, but please can I ask (my VBA knowledge is really limited):

Is there a way to change the code so that I can have it print a specific worksheet within the workbook? As opposed to the current sheet?

I have several different sheets within the workbook, and I want to manipulate the code so that it prints one of the sheets from a 'control panel' on another worksheet... if that makes any sense?

Any help would be appreciated!
Andy



		Code:
__


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A1")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## MilkyTech

andyswin said:


> Hi all,
> 
> Is there a way to change the code so that I can have it print a specific worksheet within the workbook? As opposed to the current sheet?



Change this line:


		Code:
__


  With ActiveSheet

To this:



		Code:
__


  With Sheets[COLOR=#000000][FONT=Consolas][B]([/B][/FONT][/COLOR][COLOR=blue][FONT=Consolas][B]"Your Sheet Name"[/B][/FONT][/COLOR][COLOR=#000000][FONT=Consolas][B])[/B][/FONT][/COLOR]


----------



## andyswin

thanks. I know this might sound like another silly question, but if I want to add more than one recipient, do I do this by separating an email address with a comma and then put the additional address in quotation marks?


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## MilkyTech

Yes, some email clients use comma, others like Outlook use semi-colon:


		Code:
__


.To = "johndoe@abc.com; janedoe@abc.com; joeydoe@abc.com" ' <-- Put email of the recipient here


----------



## andyswin

Thanks again - although I now have one last question (I hope!)

I am using this code in my spreadsheet 3 times, with 3 different modules, in order that I can email different data sets to different addresses etc.

In this part of the code: 



		Code:
__


  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "[COLOR="#0000FF"]Company  Name[/COLOR]" & "[COLOR="#0000FF"]Delivery Report[/COLOR]" & ".pdf"


I am changing the parts highlighted in blue for each report; however, when I run each respective macro, they are all being produced with the same filename regardless.

Any ideas?

Sorry for all the questions, and thanks again for the help!


----------



## MilkyTech

andyswin said:


> I am using this code in my spreadsheet 3 times, with 3 different modules, in order that I can email different data sets to different addresses etc.
> In this part of the code:
> 
> 
> Code:
> __
> 
> 
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "[COLOR=#0000FF]Company  Name[/COLOR]" & "[COLOR=#0000FF]Delivery Report[/COLOR]" & ".pdf"
> 
> I am changing the parts highlighted in blue for each report; however, when I run each respective macro, they are all being produced with the same filename regardless.



You can simplify the filename creation if you want.  ZVA put that "if" statement in there for someone who had a specific issue. You probably don't need it.
This will suffice:


		Code:
__


PdfFile = ActiveWorkbook.FullName
PdfFile = PdfFile & "[COLOR=#0000FF]Company  Name[/COLOR]" & "[COLOR=#0000FF]Delivery Report[/COLOR]" & ".pdf"

Now, a few questions:

    1. About getting the same filename every time:  Does each module (macro) you have assigned have a unique Sub name?
    2. Are you changing the blue text within the code everytime? (are you opening the editor and changing the module's code each time you want to email?)
    3. What exactly are you trying to achieve with your code as a whole? (explain in detail, there are many things that can be customized pretty easily such as the filenames (you can include a particular cell's content if you want, cell ranges, selected cells, you don't have to have the excel filename and extension included as the code above does, etc), how the email is filled out, signature, saving a copy of the pdf, where the pdf is saved, etc.)




-"Need more input!"


----------



## andyswin

MilkyTech said:


> Now, a few questions:
> 
> 1. About getting the same filename every time:  Does each module (macro) you have assigned have a unique Sub name?
> 2. Are you changing the blue text within the code everytime? (are you opening the editor and changing the module's code each time you want to email?)
> 3. What exactly are you trying to achieve with your code as a whole? (explain in detail, there are many things that can be customized pretty easily such as the filenames (you can include a particular cell's content if you want, cell ranges, selected cells, you don't have to have the excel filename and extension included as the code above does, etc), how the email is filled out, signature, saving a copy of the pdf, where the pdf is saved, etc.)
> 
> -"Need more input!"



Okay, so the 'cleaner' code is fine. That is, in fact, working better for me than the other, but in response to your questions -

1. Yes, each has a unique name.
2. Yes, changing the code each time.
3. I have a s/s set up to pull data through to 3 different 'reports' on 3 different tabs. The reports are all automated, I just wanted a way of emailing each one out as a PDF, without having to manually print to PDF each time, and then email - so this code works brilliantly for what I want it to do... but I am a complete beginner when it comes to VBA! I can read some of the code and sort of understand what it is doing, I just don't know what to change to make it work.

As I said, based on the 'cleaner' code you provided, this now appears to be working. Before, all the reports were sent with the same filename, regardless of what I wrote in blue.

When I press the macro buttons now, the report is generated and emailed with the filename: spreadsheet name.xlsmName In Blue Text.PDF. Ideally I would like it to just be sent with the name "Text In Blue.PDF" - but I can't figure that out either! :/

I really need to get some VBA lessons!


----------



## MilkyTech

andyswin said:


> Okay, so the 'cleaner' code is fine. That is, in fact, working better for me than the other, but in response to your questions -
> 
> 1. Yes, each has a unique name.
> 2. Yes, changing the code each time.
> 3. I have a s/s set up to pull data through to 3 different 'reports' on 3 different tabs. The reports are all automated, I just wanted a way of emailing each one out as a PDF, without having to manually print to PDF each time
> 
> Ideally I would like it to just be sent with the name "Text In Blue.PDF" - but I can't figure that out either! :/


You should never need to change the code itself.  That would defeat the whole purpose of the code which is to automate the process.  Instead, have the code insert the value of a cell.  Do you have a cell on your worksheet that is filled out with the "Company Name" that you want to name the pdf?  If not just create one.  
Any chance you can email me your workbook so I can figure out the best way to go about this for your particular situation? milkytech @ gmail


----------



## andyswin

Really all I want is to change



		Code:
__


PdfFile = ActiveWorkbook.FullName


So that instead of using the workbook name, it simply uses whatever name I give it. I get that "Company name" & "delivery report" are added as extensions - through lack of a better term - I just want the file to start with something other than the Workbook name.


----------



## MilkyTech

andyswin said:


> Really all I want is to change
> 
> 
> 
> Code:
> __
> 
> 
> PdfFile = ActiveWorkbook.FullName
> 
> 
> So that instead of using the workbook name, it simply uses whatever name I give it. I get that "Company name" & "delivery report" are added as extensions - through lack of a better term - I just want the file to start with something other than the Workbook name.



Well the issue is whether or not you are attaching the pdf to an email.  This is why I wanted you to tell me _in detail _everything you want the code to do.
If you are attaching the pdf, the path to where the pdf is exported needs to be defined in order for the code to find it and attach it.  
In this code:
	
	
	
	
	
	




		Code:
__


PdfFile = ActiveWorkbook.FullName

the FullName property is defining that path _and_ including the excel filename and extension.
For instance, if your excel doc is currently saved in your Documents folder, then "ActiveWorkbook.Fullname" will produce "C:\Users\MyUsername\Documents\MyWorkbook.xlsm".  There are other ways to define the path and still name the pdf whatever you want, but I would need to know:
    1. Do you want to attach the pdf to an email?
    2. Do you want to save a copy of the pdf for yourself?
    3. Will you be saving that copy in the same folder that your excel doc resides? If not, where do you want it saved?
    4. Do you want anything else in the pdf filename other than the company name?  Report #, Date, etc.?
5. Do you want the email filled out for you? who its being sent to, the body, etc.
6. Do you want your email signature added?

There is so much that can be done with VBA and its not difficult.
Don't worry about what the code does right now, tell me in detail everything you _want _the code to automate and we can go from there.


----------



## andyswin

1. Do you want to attach the pdf to an email?

Yes, but that was what this code was designed for, so it's already working.

 2. Do you want to save a copy of the pdf for yourself?

Nope, but the code (so far as I can tell) automatically deletes the file without saving a copy.

 3. Will you be saving that copy in the same folder that your excel doc resides? If not, where do you want it saved?

Not applicable.

 4. Do you want anything else in the pdf filename other than the company name? Report #, Date, etc.?

Yes, but the code already allows me to do this here:



		Code:
__


PdfFile = PdfFile & "Company Name" & "Delivery Report" & ".pdf"


 5. Do you want the email filled out for you? who its being sent to, the body, etc.

Already done in the code below.

 6. Do you want your email signature added?

Again, already in the code below.

I literally just want to change it so that the Workbook name is not part of the filename.

'My' Code -



		Code:
__


Sub CompanyName() '<-- Remember to change the Sub name with each new counteparty
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A1")
 
  ' Define PDF filename

PdfFile = ActiveWorkbook.FullName
PdfFile = PdfFile & "Company Name" & "Delivery Report" & ".pdf" '<-- Change the name of the file to match the counterparty
 
  ' Export activesheet as PDF
  With Worksheets("TabA")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = "Company - Biomass Deliveries - " & Range("E18").Value
    .To = "contact@XYZ.com" '<-- Put email of the recipient here
    .CC = "inbox@XYZ.com" '<-- Put email of 'CC' recipient here
    
    '<-- The 'Body' section contains the content of the email signature, only amend this if the address changes of group email changes
    
    .Body = "Hi," & vbLf & vbLf _
          & "Please find attached our delivery records for last week." & vbLf & vbLf _
          & "Please contact us at: inbox@XYZ.com if you have any issues." & vbLf & vbLf _
          & "Kind regards," & vbLf _
          & Application.UserName & vbLf & vbLf _
          & "Address & vbLf_


    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## MilkyTech

andyswin said:


> 4. Do you want anything else in the pdf filename other than the company name? Report #, Date, etc.?
> Yes, but the code already allows me to do this here:
> 
> 
> Code:
> __
> 
> 
> PdfFile = PdfFile & "Company Name" & "Delivery Report" & ".pdf"


Again, if your code and workbook are set up correctly, you will never need to open your VBA editor and change the code ever again.  All changes should be made in your workbook, then the code can "import" those changes.  You are already doing this in your ".Subject" line of code where you import the value of cell E18.  I am assuming the "Company Name" is different for each report you email.  You should have a cell in your workbook that contains this company name, where you can simply type a different company name here before you click your macro button.
ie:


		Code:
__


PdfFile = PdfFile & ActiveSheet.Range("A1").Value & "Delivery Report" & ".pdf"




> 5. Do you want the email filled out for you? who its being sent to, the body, etc.
> Already done in the code below.


Again, I assume you're not sending these reports to the same recipient everytime.  If you are, great, just put that email address in the code and never change it, but if my assumption is correct and the recipients change, then you should again, import the value of a cell which is much easier to change than the code.
ie:


		Code:
__


.To = ActiveSheet.Range("E10").Value




> 6. Do you want your email signature added?
> Again, already in the code below.


Your code is not adding an email signature.  It is simply adding text to the body of the email and then adding the current username.  An email signature is one that you created in Outlook.  The code can add that Outlook signature if you wanted. 


> I literally just want to change it so that the Workbook name is not part of the filename.





		Code:
__


PdfFile = ThisWorkbook.Path & Application.PathSeparator & "Company Name" & "_Delivery Report" & ".pdf"

Again, you should import the Company Name from a cell.  If the cell is on the same worksheet as your macro button, then it should look something like this:


		Code:
__


PdfFile = ThisWorkbook.Path & Application.PathSeparator & ActiveSheet.Range("A1").Value & "_Delivery Report" & ".pdf"

If the Company Name is on a different sheet, then something like this:


		Code:
__


PdfFile = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Sheets("TabA").Range("A19") & "_Delivery Report" & ".pdf"

Or even better, like this:


		Code:
__


With ThisWorkbook
    PdfFile = .Path & Application.PathSeparator & .Sheets("TabA").Range("A19") & "_Delivery Report" & ".pdf"
End With

Also take note:  Change ".Send" to ".Display" to view the email and make changes before sending.  This is especially useful for testing your code.  Once you are sure everything is working and your email looks exactly as you want it, then change it back to ".Send" to immediately send it without viewing.
Also, you can remove the line of code (or comment it out by adding an apostrophe in front of it) that makes a msgbox pop up to say the email was sent successfully.  This is unnecessary and annoying to have to close that msgbox each time.  The previous line of code that tells you if the email was _not_ sent is all you need. If you don't get this error message, then you know it was successful.

All in all, I would have the code look something like this:


		Code:
__


Sub CompanyName()
  Dim IsCreated As Boolean
  Dim PdfFile As String
  Dim OutlApp As Object


  ' Define PDF filename
  With ThisWorkbook
    PdfFile = .Path & Application.PathSeparator & .Sheets("TabA").Range("A19") & "_Delivery Report" & ".pdf"
  End With
 
  ' Export activesheet as PDF
  With Worksheets("TabA")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = "Company - Biomass Deliveries - " & Range("E18").Value
    .To = ActiveSheet.Range("E10").Value '<-- Put email of the recipient here
    .CC = ActiveSheet.Range("E11").Value '<-- Put email of 'CC' recipient here
    
    '<-- The 'Body' section contains the content of the email signature, only amend this if the address changes of group email changes
    
    .Body = "Hi," & vbLf & vbLf _
          & "Please find attached our delivery records for last week." & vbLf & vbLf _
          & "Please contact us at: inbox@XYZ.com if you have any issues." & vbLf & vbLf _
          & "Kind regards," & vbLf _
          & Application.UserName & vbLf & vbLf _
          & Address & vbLf_                                   ' <---This line isn't doing anything




    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
    ' MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## PMcDonald

Hello:

I am using your code to convert an excel worksheet to a pdf and email it as an attachment. I have Excel and Outlook 2013. I allow the user to enter the email addresses he wants to send this to, and allow him to send the email. The code I am using (with your help) works beautifully, as follows:




		Rich (BB code):
__







		Rich (BB code):
__


Sub AttachActiveSheetPDF_01()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

   ' Define PDF filename
  Title = Range("C218").Value
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"


  ' Exportactivesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "" ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    Application.Visible = True
    .Display
  End With

  ' Quit Outlook if it was not already open
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

End Sub


After the user sends the email, is it possible to save a pdf of the email to a network drive, Path = "Z:\Emails - EAST\2016\"FileName = Range("C218")?  This would provide proof that the email with attachment was definitely sent to the email recipient.

Thanks very much for any help!


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## MilkyTech

For it to be "proof" you would somehow need a copy of the email AFTER it is sent, so the code would need to wait for the user to finish working on the email, then pull it from the Sent mailbox in outlook, then save it.  

A couple of easier methods would provide you the proof you need:



You could simply add a .BCC to your code:
	
	
	
	
	
	




		Code:
__


    .BCC = "mySecureEmail@abc.com"


You can create a rule in outlook that will take any email with, for example, "completed case review" in the body and either move a copy to another folder in outlook or forward a copy to a secure email of your choice

Both methods provide you full proof and if you use an external web based email to copy it to, then you can save yourself the local storage space as well.

If you just want to save a copy of the pdf you are attaching to a network drive, that is much simpler and we can definitely accomplish that, but that does not provide any proof the email was actually sent.


----------



## PMcDonald

I appreciate the other methods suggested.  Unfortunately, I do need the pdf copy of the email AFTER it is sent to be saved on our Z drive.  I would change the subject line of the email to "Completed Case Review".  Every user will have a CutePDF Writer identified as a printer in their Outlook program, since not everybody has Adobe.  If it is possible for the code to immediately access (after the user presses send) the last email with Completed Case Review in the subject line in their Sent mailbox in Outlook and save it as a pdf on the Z drive, please let me know.  Otherwise, I may have to have the users manually take care of this, or bcc myself and I would take care of it for them.  We have 500-600 of these annually, so automating it is definitely preferred.

If you have any more ideas, please let me know.  I really appreciate your assistance.  Thanks very much!


----------



## MilkyTech

I'm sure it is possible, since well just about anything is possible with enough code and we are already controlling outlook from an excel vba script, however, that would be beyond my level of expertise which is pretty much limited to this thread!   I would recommend starting a new thread as this thread is quite old and I am the only one who responds anymore.  Let me see what I can do though.

I would think this would be easier to accomplish if the entire email was filled out _and _sent from the code, then we would only need to figure out how to grab the email from the sent folder. 

 Is the only reason the user sends the email so they can enter email addresses?  You could simply have a few cells on the worksheet for entering emails then just pull the value from those cells with your code to fill out the email:



		Code:
__


.Subject = Title    
    .To = ActiveSheet.Range("A1").Value 
    .CC = ActiveSheet.Range("A2").Value 
    .BCC = ActiveSheet.Range("A3").Value


Then use .Send instead of .Display

Then our next piece of code will hopefully grab any email from the sent folder with key words in the subject and print it to pdf and save it.  I'll get back to you, but start a new thread and let me know if you get a solution before I do.


----------



## MilkyTech

I've got a solution that requires a combination of your excel script and a rule in outlook that has a rule set to run a script on emails sent with certain key words.  Are you still interested?


----------



## MilkyTech

Done.  Got it all in 1 module.  No need for Outlook rule.  See it all here: Integrate Outlook "Run as Script" rule into Excel VBA code that sends email - Stack Overflow

Final working code for you is in my answer to my own question.


----------



## PMcDonald

Thank you for all your help!  I made just a few tweaks, but when I run the code, I get a _Run-time error '5' Invalid procedure call or argument_.  

When I step through, the following repeats over and over again.

 If olItem.Class = olMail Then
            If olItem.Subject = Esub Then  '<-- check for match
                SaveAsPDF olItem '< - Call SaveAsPDF code
            End If
        End If
    Next

Can you help?





		Rich (BB code):
__


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String, Esub As String
  Dim OutlApp As Object
  Dim sendTime As String

    sendTime = Now()
    sendTime = Format(sendTime, "yyyymmm-dd, hh:mm:ss")

  ' ### Define email subject and PDF path & filename ###
  Title = Range("C218").Value
  Esub = "Completed Case Review " & sendTime
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"


  ' ### Export ActiveSheet to PDF ###
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' ### Open Outlook ###
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")  '<-- If open, use it
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")  '<-- If not, open it
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' ### Prepare email and attach pdf created above ###
  With OutlApp.CreateItem(0)

    .Subject = Esub
    .To = ""   ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    Application.Visible = True
    .Display True '<-- True forces code to wait for user to send email. Or just automate what the user is doing and change this to .Send
  End With

  Application.Wait (Now + TimeValue("0:00:05"))  '<-- 5 second delay allows email to finish sending

' ### Search Sent Mail folder for emails with same timestamp in subject ###
    Dim olNameSpace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object

    Set olNameSpace = OutlApp.GetNamespace("MAPI")
    Set olFolder = olNameSpace.GetDefaultFolder(olFolderSentMail)
    Set olItem = OutlApp.CreateItem(olMailItem)

    For Each olItem In olFolder.Items
        If olItem.Class = olMail Then
            If olItem.Subject = Esub Then  '<-- check for match
                SaveAsPDF olItem '< - Call SaveAsPDF code
            End If
        End If
    Next

    If IsCreated Then OutlApp.Quit  '<-- Quit Outlook if it was not already open
  Set OutlApp = Nothing  '<-- Release the memory of object variable

   ' ### Delete our temp pdf file if not needed anymore ###
  Kill PdfFile

End Sub


Sub SaveAsPDF(MyMail As MailItem)

' ### Requires reference to Microsoft Scripting Runtime ###
' ### Requires reference to Microsoft Outlook Object Library ###
' ### Requires reference to Microsoft Word Object Library ###
' --- In VBE click TOOLS > REFERENCES and check the boxes for all of the above ---

  Dim fso As FileSystemObject
  Dim emailSubject As String
  Dim saveName As String
  Dim blnOverwrite As Boolean
  Dim bPath As String
  Dim strFolderPath As String
  Dim sendEmailAddr As String
  Dim senderName As String
  Dim looper As Integer
  Dim plooper As Integer
  Dim strID As String
  Dim olNS As Outlook.Namespace
  Dim oMail As Outlook.MailItem

  strID = MyMail.EntryID
  Set App = CreateObject("Outlook.Application")
  Set olNS = App.GetNamespace("MAPI")
  Set oMail = olNS.GetItemFromID(strID)

  ' ### Get username portion of sender's email address ###
  sendEmailAddr = oMail.SenderEmailAddress
  senderName = Left(sendEmailAddr, InStr(sendEmailAddr, "@") - 1)

  ' ### USER OPTIONS ###
  blnOverwrite = False ' False = don't overwrite, True = do overwrite

  ' ### Path to directory for saving pdf copy of sent email ###
  bPath = "Z:\Emails - East\2016\"

  ' ### Create Directory if it doesnt exist ###
  If Dir(bPath, vbDirectory) = vbNullString Then
      MkDir bPath
  End If

  ' ### Get Email subject & set name to be saved as ###
  emailSubject = CleanFileName(oMail.Subject)
  saveName = emailSubject & ".mht"
  Set fso = CreateObject("Scripting.FileSystemObject")

  ' ### Save .mht file to create pdf from within Word ###
  oMail.SaveAs bPath & saveName, olMHTML
  pdfSave = bPath & emailSubject & "_" & senderName & "_" & ".pdf"

  ' ### Open Word to convert .mht file to PDF ###
  Dim wrdApp As Word.Application
  Dim wrdDoc As Word.Document
  Set wrdApp = CreateObject("Word.Application")

  ' ### Open .mht file we just saved and export as PDF ###
  Set wrdDoc = wrdApp.Documents.Open(FileName:=bPath & saveName, Visible:=True)
        wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                pdfSave, ExportFormat:= _
                wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
                wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=0, To:=0, _
                Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
                CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=True, UseISO19005_1:=False

  wrdDoc.Close
  wrdApp.Quit

  ' ### Delete our temp .mht file ###
  Kill bPath & saveName

  ' ### Uncomment this section to save attachments also ###
  'If oMail.Attachments.Count > 0 Then
  '    For Each atmt In oMail.Attachments
  '        atmtName = CleanFileName(atmt.FileName)
  '        atmtSave = bPath & Format(oMail.ReceivedTime, "yyyy-mm-dd-hhmm") & "_" & atmtName
  '        atmt.SaveAsFile atmtSave
  '    Next
  'End If

  Set oMail = Nothing
  Set olNS = Nothing
  Set fso = Nothing
End Sub


Function CleanFileName(strText As String) As String
Dim strStripChars As String
Dim intLen As Integer
Dim i As Integer
strStripChars = "/\[]:=," & Chr(34)
intLen = Len(strStripChars)
strText = Trim(strText)
For i = 1 To intLen
strText = Replace(strText, Mid(strStripChars, i, 1), "")
Next
CleanFileName = strText
End Function


----------



## MilkyTech

You modified the filename when you changed the format of sendTime.  Colon's are not a valid character in a filename.
Also, make sure you have checked the references required:


		Code:
__


' ### Requires reference to Microsoft Scripting Runtime ###
' ### Requires reference to Microsoft Outlook Object Library ###
' ### Requires reference to Microsoft Word Object Library ###


----------



## PMcDonald

Thank you.

I removed the colons.  I have the required references checked.

When I run the code, i still get a [/COLOR]_Run-time error '5' Invalid procedure call or argument. 

When I step through, the following repeats over and over again.  Could it be a naming issue?

If olItem.Class = olMail Then
If olItem.Subject = Esub Then '<-- check for match
SaveAsPDF olItem '< - Call SaveAsPDF code
End If
End If
Next

Here's the code for everything:



		Rich (BB code):



Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String, Esub As String
  Dim OutlApp As Object
  Dim sendTime As String

    sendTime = Now()
    sendTime = Format(sendTime, "yyyymmm-dd, hhmm AM/PM")

  ' ### Define email subject and PDF path & filename ###
  Title = Range("C218").Value
  Esub = "Completed Case Review " & sendTime
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"


  ' ### Export ActiveSheet to PDF ###
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' ### Open Outlook ###
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")  '<-- If open, use it
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")  '<-- If not, open it
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' ### Prepare email and attach pdf created above ###
  With OutlApp.CreateItem(0)

    .Subject = Esub
    .To = ""   ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    Application.Visible = True
    .Display True '<-- True forces code to wait for user to send email. Or just automate what the user is doing and change this to .Send
  End With

  Application.Wait (Now + TimeValue("0:00:05"))  '<-- 5 second delay allows email to finish sending

' ### Search Sent Mail folder for emails with same timestamp in subject ###
    Dim olNameSpace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object

    Set olNameSpace = OutlApp.GetNamespace("MAPI")
    Set olFolder = olNameSpace.GetDefaultFolder(olFolderSentMail)
    Set olItem = OutlApp.CreateItem(olMailItem)

    For Each olItem In olFolder.Items
        If olItem.Class = olMail Then
            If olItem.Subject = Esub Then  '<-- check for match
                SaveAsPDF olItem '< - Call SaveAsPDF code
            End If
        End If
    Next
    If IsCreated Then OutlApp.Quit  '<-- Quit Outlook if it was not already open
  Set OutlApp = Nothing  '<-- Release the memory of object variable

   ' ### Delete our temp pdf file if not needed anymore ###
  Kill PdfFile

End Sub


Sub SaveAsPDF(MyMail As MailItem)

' ### Requires reference to Microsoft Scripting Runtime ###
' ### Requires reference to Microsoft Outlook Object Library ###
' ### Requires reference to Microsoft Word Object Library ###
' --- In VBE click TOOLS > REFERENCES and check the boxes for all of the above ---

  Dim fso As FileSystemObject
  Dim emailSubject As String
  Dim saveName As String
  Dim blnOverwrite As Boolean
  Dim bPath As String
  Dim strFolderPath As String
  Dim sendEmailAddr As String
  Dim senderName As String
  Dim looper As Integer
  Dim plooper As Integer
  Dim strID As String
  Dim olNS As Outlook.Namespace
  Dim oMail As Outlook.MailItem

  strID = MyMail.EntryID
  Set App = CreateObject("Outlook.Application")
  Set olNS = App.GetNamespace("MAPI")
  Set oMail = olNS.GetItemFromID(strID)

  ' ### Get username portion of sender's email address ###
  sendEmailAddr = oMail.SenderEmailAddress
  senderName = Left(sendEmailAddr, InStr(sendEmailAddr, "@") - 1)

  ' ### USER OPTIONS ###
  blnOverwrite = False ' False = don't overwrite, True = do overwrite

  ' ### Path to directory for saving pdf copy of sent email ###
  bPath = "Z:\Emails - East\2016\"

  ' ### Create Directory if it doesnt exist ###
  If Dir(bPath, vbDirectory) = vbNullString Then
      MkDir bPath
  End If

  ' ### Get Email subject & set name to be saved as ###
  emailSubject = CleanFileName(oMail.Subject)
  saveName = emailSubject & ".mht"
  Set fso = CreateObject("Scripting.FileSystemObject")

  ' ### Save .mht file to create pdf from within Word ###
  oMail.SaveAs bPath & saveName, olMHTML
  pdfSave = bPath & emailSubject & "_" & senderName & "_" & ".pdf"

  ' ### Open Word to convert .mht file to PDF ###
  Dim wrdApp As Word.Application
  Dim wrdDoc As Word.Document
  Set wrdApp = CreateObject("Word.Application")

  ' ### Open .mht file we just saved and export as PDF ###
  Set wrdDoc = wrdApp.Documents.Open(FileName:=bPath & saveName, Visible:=True)
        wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                pdfSave, ExportFormat:= _
                wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
                wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=0, To:=0, _
                Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
                CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=True, UseISO19005_1:=False

  wrdDoc.Close
  wrdApp.Quit

  ' ### Delete our temp .mht file ###
  Kill bPath & saveName

  ' ### Uncomment this section to save attachments also ###
  'If oMail.Attachments.Count > 0 Then
  '    For Each atmt In oMail.Attachments
  '        atmtName = CleanFileName(atmt.FileName)
  '        atmtSave = bPath & Format(oMail.ReceivedTime, "yyyy-mm-dd-hhmm") & "_" & atmtName
  '        atmt.SaveAsFile atmtSave
  '    Next
  'End If

  Set oMail = Nothing
  Set olNS = Nothing
  Set fso = Nothing
End Sub


Function CleanFileName(strText As String) As String
Dim strStripChars As String
Dim intLen As Integer
Dim i As Integer
strStripChars = "/\[]:=," & Chr(34)
intLen = Len(strStripChars)
strText = Trim(strText)
For i = 1 To intLen
strText = Replace(strText, Mid(strStripChars, i, 1), "")
Next
CleanFileName = strText
End Function


Thanks again for all your help!_


----------



## MilkyTech

Dude, you're kiddin me, right?

You got rid of the colons but added a Slash!  That also is not an acceptable character in a filename.


Go to any file on your computer and rename it.  If you try to put a slash or colon, you will get a popup warning that lists all of the characters that are not acceptable.  Check it out.


----------



## PMcDonald

Got it.  I don't know what I'm doing!

 I removed the slash. I have the required references checked.

 When I run the code, i still get:  Run-time error '5': Invalid procedure call or argument. 

 When I step through, the following repeats over and over again.

If olItem.Class = olMail Then
 If olItem.Subject = Esub Then '<-- check for match
 SaveAsPDF olItem '< - Call SaveAsPDF code
 End If
 End If
 Next

 Here's the code for everything:



		Code:
__


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String, Esub As String
  Dim OutlApp As Object
  Dim sendTime As String

    sendTime = Now()
    sendTime = Format(sendTime, "yyyymmm-dd, hhmm")

  ' ### Define email subject and PDF path & filename ###
  Title = Range("C218").Value
  Esub = "Completed Case Review " & sendTime
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"


  ' ### Export ActiveSheet to PDF ###
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' ### Open Outlook ###
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")  '<-- If open, use it
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")  '<-- If not, open it
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' ### Prepare email and attach pdf created above ###
  With OutlApp.CreateItem(0)

    .Subject = Esub
    .To = ""   ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    Application.Visible = True
    .Display True '<-- True forces code to wait for user to send email. Or just automate what the user is doing and change this to .Send
  End With

  Application.Wait (Now + TimeValue("0:00:05"))  '<-- 5 second delay allows email to finish sending

' ### Search Sent Mail folder for emails with same timestamp in subject ###
    Dim olNameSpace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItem As Object

    Set olNameSpace = OutlApp.GetNamespace("MAPI")
    Set olFolder = olNameSpace.GetDefaultFolder(olFolderSentMail)
    Set olItem = OutlApp.CreateItem(olMailItem)

    For Each olItem In olFolder.Items
        If olItem.Class = olMail Then
            If olItem.Subject = Esub Then  '<-- check for match
                SaveAsPDF olItem '< - Call SaveAsPDF code
            End If
        End If
    Next

    If IsCreated Then OutlApp.Quit  '<-- Quit Outlook if it was not already open
  Set OutlApp = Nothing  '<-- Release the memory of object variable

   ' ### Delete our temp pdf file if not needed anymore ###
  Kill PdfFile

End Sub


Sub SaveAsPDF(MyMail As MailItem)

' ### Requires reference to Microsoft Scripting Runtime ###
' ### Requires reference to Microsoft Outlook Object Library ###
' ### Requires reference to Microsoft Word Object Library ###
' --- In VBE click TOOLS > REFERENCES and check the boxes for all of the above ---

  Dim fso As FileSystemObject
  Dim emailSubject As String
  Dim saveName As String
  Dim blnOverwrite As Boolean
  Dim bPath As String
  Dim strFolderPath As String
  Dim sendEmailAddr As String
  Dim senderName As String
  Dim looper As Integer
  Dim plooper As Integer
  Dim strID As String
  Dim olNS As Outlook.Namespace
  Dim oMail As Outlook.MailItem

  strID = MyMail.EntryID
  Set App = CreateObject("Outlook.Application")
  Set olNS = App.GetNamespace("MAPI")
  Set oMail = olNS.GetItemFromID(strID)

  ' ### Get username portion of sender's email address ###
  sendEmailAddr = oMail.SenderEmailAddress
  senderName = Left(sendEmailAddr, InStr(sendEmailAddr, "@") - 1)

  ' ### USER OPTIONS ###
  blnOverwrite = False ' False = don't overwrite, True = do overwrite

  ' ### Path to directory for saving pdf copy of sent email ###
  bPath = "Z:\Emails - East\2016\"

  ' ### Create Directory if it doesnt exist ###
  If Dir(bPath, vbDirectory) = vbNullString Then
      MkDir bPath
  End If

  ' ### Get Email subject & set name to be saved as ###
  emailSubject = CleanFileName(oMail.Subject)
  saveName = emailSubject & ".mht"
  Set fso = CreateObject("Scripting.FileSystemObject")

  ' ### Save .mht file to create pdf from within Word ###
  oMail.SaveAs bPath & saveName, olMHTML
  pdfSave = bPath & emailSubject & "_" & senderName & "_" & ".pdf"

  ' ### Open Word to convert .mht file to PDF ###
  Dim wrdApp As Word.Application
  Dim wrdDoc As Word.Document
  Set wrdApp = CreateObject("Word.Application")

  ' ### Open .mht file we just saved and export as PDF ###
  Set wrdDoc = wrdApp.Documents.Open(FileName:=bPath & saveName, Visible:=True)
        wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                pdfSave, ExportFormat:= _
                wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
                wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=0, To:=0, _
                Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
                CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=True, UseISO19005_1:=False

  wrdDoc.Close
  wrdApp.Quit

  ' ### Delete our temp .mht file ###
  Kill bPath & saveName

  ' ### Uncomment this section to save attachments also ###
  'If oMail.Attachments.Count > 0 Then
  '    For Each atmt In oMail.Attachments
  '        atmtName = CleanFileName(atmt.FileName)
  '        atmtSave = bPath & Format(oMail.ReceivedTime, "yyyy-mm-dd-hhmm") & "_" & atmtName
  '        atmt.SaveAsFile atmtSave
  '    Next
  'End If

  Set oMail = Nothing
  Set olNS = Nothing
  Set fso = Nothing
End Sub


Function CleanFileName(strText As String) As String
Dim strStripChars As String
Dim intLen As Integer
Dim i As Integer
strStripChars = "/\[]:=," & Chr(34)
intLen = Len(strStripChars)
strText = Trim(strText)
For i = 1 To intLen
strText = Replace(strText, Mid(strStripChars, i, 1), "")
Next
CleanFileName = strText
End Function

Can you help?


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## MilkyTech

Did you try running the code exactly as I posted it without any modifications?  I would start there since I tested it successfully many times.  
If you still get an error with my code, unaltered, then something is wrong with your setup.  Are you sure your Z drive is accessible?  Try my original code but change "Z:\" to "C:\" and see if it works on your local C drive.
If you are successful with either of these attempts, then you know the problem is with your changes.  Start to make your changes one at a time, testing each time, until you get an error, then you will see where you went awry.


----------



## rbrace

MilkyTech said:


> you need to adjust this section:
> 
> 
> Rich (BB code):
> __
> 
> 
> _' Define PDF filename
> __  PdfFile = ActiveWorkbook.FullName
> __  i = InStrRev(PdfFile, ".")
> __If__ i > 1 __Then__ PdfFile = Left(PdfFile, i - 1)
> __  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"_
> 
> _
> to read:
> _
> 
> 
> Rich (BB code):
> __
> 
> 
> _' Define PDF filename
> __PdfFile = ActiveSheet.Name & ".pdf"_
> 
> 
> You can make the filename anything you want in this section




I am trying the above modification to name the PDF file the same as the sheet name but it errors on line .Attachments.Add PdfFile
What am I doing wrong?

Thank you for the help,




		Code:
__


Sub AttachActiveSheetPDF()  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A1")
   
   ' Define PDF filename
'  PdfFile = ActiveWorkbook.FullName
'  i = InStrRev(PdfFile, ".")
'  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
'  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
PdfFile = ActiveSheet.Name & ".pdf"




  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "" ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Display
'    Application.Visible = True
'    If Err Then
'      MsgBox "E-mail was not sent", vbExclamation
'    Else
'      MsgBox "E-mail successfully sent", vbInformation
'    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## MilkyTech

You need to define the complete path in order for the code to find the pdf file and attach it.  You have only given the pdf a filename, but no path.
Something like this will define the same path that the current workbook resides:


		Code:
__


 With ThisWorkbook
    PdfFile = .Path & Application.PathSeparator & ActiveSheet.Name & ".pdf"
 End With


----------



## CodyMonster

Thanks everyone for the quick resource on this,its been a great to have this available. However, I've read through all of the 14 pages and I can't get a answer to this. 
For some reason the line in the code at With OutlApp.CreateItem(0) doesn't make the new email message pop up. 
Everything else works, PDF file created, etc. But, I can't get Outlook to automate. Don't get any errors, just doesn't execute the outlook commands. 
Has anyone has had the same problems? 
Thanks for any help..


----------



## MilkyTech

Post your code for us


----------



## CodyMonster

MilkyTech said:


> Post your code for us



Its the same as the original code



		Code:
__


Sub AttachActiveSheetPDF()  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A2")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 Debug.Print PdfFile
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)  [COLOR=#ff0000]<---- doesn't do anything[/COLOR]
   
    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
 


 
End Sub


----------



## MilkyTech

You have your code set up to immediately send the email (.Send) so you won't see it pop up.  check your sent mailbox and you should see the email with attachment sent.  your code works fine for me.

Change *.Send *to *.Display *and then the email will pop up for you to make adjustments and manually send.


----------



## CodyMonster

MilkyTech said:


> You have your code set up to immediately send the email (.Send) so you won't see it pop up.  check your sent mailbox and you should see the email with attachment sent.  your code works fine for me.
> 
> Change *.Send *to *.Display *and then the email will pop up for you to make adjustments and manually send.




Hey, it worked!! Okay, I feel dumb now!


----------



## zoetwodot

MilkyTech said:


> Did you try running the code exactly as I posted it without any modifications?  I would start there since I tested it successfully many times.
> If you still get an error with my code, unaltered, then something is wrong with your setup.  Are you sure your Z drive is accessible?  Try my original code but change "Z:\" to "C:\" and see if it works on your local C drive.
> If you are successful with either of these attempts, then you know the problem is with your changes.  Start to make your changes one at a time, testing each time, until you get an error, then you will see where you went awry.



Can you please clarify how to instruct the PDF to be saved on a network folder?  Everything else is working except that step.  The filepath is P:\Finance\Trade Tickets Scanned if that could be used in the example.

(1 million thank yous to all involved in this thread)

Z


----------



## MilkyTech

let me see your code please.  It should be as simple as typing the path as you have.  test on your local drive.  post your code.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## zoetwodot

I figured it out by adding this; not sure if it needs to be it's own instruction

'Export to network folder as PDF
 With ActiveSheet
 .ExportAsFixedFormat Type:=xlTypePDF, Filename:="P:\Finance\Trade Tickets Scanned\" & Range("B8").Value & Format(Date, " yyyy.mm.dd") & Format(Time, " hh.mm.ss")
 End With


----------



## MilkyTech

there you go.  i saw your code on your other post.  near the beginning you defined the pdf path as the current folder and gave it a filename of the ActiveSheet:


		Code:
__


[COLOR=#333333]' Set pdf filename and path to folder where excel doc is currently saved[/COLOR]
[COLOR=#333333]With ThisWorkbook[/COLOR]
[COLOR=#333333]PdfFile = .Path & Application.PathSeparator & ActiveSheet.Name & ".pdf"[/COLOR]
[COLOR=#333333]End With[/COLOR]

That is some older code you are working with and can be cleaned up a bit.


----------



## zoetwodot

MilkyTech said:


> there you go.  i saw your code on your other post.  near the beginning you defined the pdf path as the current folder and gave it a filename of the ActiveSheet:
> 
> 
> Code:
> __
> 
> 
> [COLOR=#333333]' Set pdf filename and path to folder where excel doc is currently saved[/COLOR]
> [COLOR=#333333]With ThisWorkbook[/COLOR]
> [COLOR=#333333]PdfFile = .Path & Application.PathSeparator & ActiveSheet.Name & ".pdf"[/COLOR]
> [COLOR=#333333]End With[/COLOR]
> 
> That is some older code you are working with and can be cleaned up a bit.



Thank you for reviewing it.

In my case the PDF needs to be saved in a different location than the Excel file.


----------



## Historik

Hi,

This code is working perfect for me, but my colleagues receive a "run-time error '-2147018887 (80071779)': Document not saved error" when they try to run the macro.

It stops at  .Attachments.Add PdfFile which is highlighted in yellow. 

Any ideas? Both versions of Excel are the same (2013 Professional), so that couldn't be the problem I think.




		Code:
__


Sub AttachActiveSheetPDF()  Dim IsCreated As Boolean
  Dim I As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Title
  Title = Range("F17")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  I = InStrRev(PdfFile, ".")
  If I > 1 Then PdfFile = Left(PdfFile, I - 1)
  PdfFile = ActiveSheet.Range("F18") & ".pdf"
 
  ' Export activesheet as PDF
  Worksheets("Estimator").Rows("34:35").EntireRow.Hidden = False
  With Worksheets("Estimator").Range("A1:E40")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  Worksheets("Estimator").Rows("34:35").EntireRow.Hidden = True
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = Range("F15") ' <-- Put email of the recipient here
    .CC = Range("F16") ' <-- Put email of 'copy to' recipient here
    .Body = "test"


    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


Thanks in advance.


----------



## MilkyTech

Are you sure you didn't add a line of code before giving it to your colleagues? 

Here you have a path to save to:
	
	
	
	
	
	




		Code:
__


PdfFile = ActiveWorkbook.FullName

Then you take away the path and just give it a filename here:
	
	
	
	
	
	




		Code:
__


PdfFile = ActiveSheet.Range("F18") & ".pdf"

When you export your pdf, you are using the variable 'PdfFile' for the filename which needs to include a path:
	
	
	
	
	
	




		Code:
__


.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile...


----------



## MilkyTech

Try this:  (I've changed '.Send' to '.Display' for testing purposes.  change it back when you are ready to automatically send the email immediately.  Also, if you want to save a copy of the pdf, comment-out or delete the line 'Kill PdfFile')


		Code:
__


Sub AttachActiveSheetPDFMilkyTech()
  Dim IsCreated As Boolean
  Dim PdfFile As String
  Dim OutlApp As Object
 
 
  ' Define PDF filename
  With ThisWorkbook
    PdfFile = .Path & Application.PathSeparator & _
              ActiveSheet.Range("F18") & ".pdf"
  End With
 
  ' Export activesheet as PDF
  Worksheets("Estimator").Rows("34:35").EntireRow.Hidden = False
  With Worksheets("Estimator").Range("A1:E40")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  Worksheets("Estimator").Rows("34:35").EntireRow.Hidden = True
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = ActiveSheet.Range("F17").Value
    .To = ActiveSheet.Range("F15").Value ' <-- Put email of the recipient here
    .CC = ActiveSheet.Range("F16").Value ' <-- Put email of 'copy to' recipient here
    .Body = "test"




    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
     ' MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## Historik

Hi MilkyTech,

The PdfFile variable was, indeed, a duplicate. I've removed the first one from the code. This was not giving any errors though.

The recommendation you gave results in no success unfortunately. The strange part is that the unmodified code (before your recommendation) also works at another colleague of mine.

I'm kinda lost in this one..


----------



## Michael M

what value is in Range("F18")


----------



## Historik

The name of the pdf file:

20160510_Recurring Support Costs Quotation- Name of service here - Start date 5th May 2016

Maybe also good to know is that the code below, so only displaying the PDF file, is working for my colleagues.



		Code:
__


Sub Preview()  Dim IsCreated As Boolean
  Dim I As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Title
  Title = Range("F17")
 
  ' Define PDF filename
  I = InStrRev(PdfFile, ".")
  If I > 1 Then PdfFile = Left(PdfFile, I - 1)
  PdfFile = ActiveSheet.Range("F18") & ".pdf"
 
  ' Export activesheet as PDF
  Worksheets("Estimator").Rows("34:35").EntireRow.Hidden = False
  With Worksheets("Estimator").Range("A1:E40")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  Worksheets("Estimator").Rows("34:35").EntireRow.Hidden = True
  End With


End Sub


----------



## MilkyTech

@Historik, you removed the wrong one.  The first one had a path, the second one doesn't.  without a path, the pdf will probably be saved in your Documents folder but Outlook won't know it's there to attach it to an email.  This is why your "Preview" Sub works but your full code doesn't.

The "Title" variable is unnecessary code and should be eliminated (as I have done in the code I posted for you).  The filename manipulation is also unnecessary as long as there aren't any illegal filename characters in cell F18.

Start with the code I posted for you, I have tested it several times and it definitely works as is.   Try it without modifying it _at all_, then tweak it from there as needed.  If it works for some and not others, then the others have something wrong with their computer setup.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## Padthelad

This thread is great. Worked for almost exactly what I needed. I used the code ZVI used and also amended it to 'display' instead of 'send'. I would like to enter an email address from cell C40 in to the email. What is the code for this?

Thanks,

Pad


----------



## ZVI

Hi Pad, 
This part of code (see in red & bold) will get email address from C40


		Rich (BB code):
__


  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
 
    ' Prepare e-mail
    .Subject = Title
    *.To = Range("C40").Value *   ' It is assumed the list of recipient emails is in C40

Regards


----------



## Colmans

Gents

Thanks for your input. The code has been really helpful. I have used ZVI's original code and tweeked it slightly so it creates and names a pdf based on a range in my spreadsheet. However, I'd like to be able to do the following two things to the code:


1. Save the pdf file to a network address
2. Incorporate a date in the file name when originated, preferably the date it is sent, but also an option for the date being selected from a cell in my worksheet



		Code:
__


Sub SendQuoteEmail()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = ActiveSheet.Range("H9")
 
  ' Define PDF filename
   PdfFile = ActiveSheet.Range("H9") & ".pdf"
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title & " ABN AMRO Lease Settlement"
    .To = "" ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail not created", vbExclamation
    Else
      MsgBox "E-mail ready to send", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## MilkyTech

Try this (you will need to adjust the email body content):


		Code:
__


Sub AttachPdfSaveNetwork()
  Dim IsCreated As Boolean
  Dim PdfFile As String, EmailSubject As String, SavePath As String
  Dim OutlApp As Object
  Dim sendTime As String


    sendTime = Now()
    sendTime = Format(sendTime, "yyyy-mm-dd-hhmmss")


  ' ### Define email subject and PDF path & filename ###
  
  EmailSubject = sendTime & "_" & ActiveSheet.Range("H9")
  
  SavePath = "Z:\MyNetworkFolder\"
  If Dir(SavePath, vbDirectory) = vbNullString Then
      MkDir SavePath
  End If
  
  PdfFile = SavePath & EmailSubject & ".pdf"
  
  ' ### Export ActiveSheet to PDF ###
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With


  ' ### Open Outlook ###
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")  '<-- If open, use it
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")  '<-- If not, open it
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0


  ' ### Prepare email and attach pdf created above ###
  With OutlApp.CreateItem(0)


    .Subject = EmailSubject & "_ABN AMRO Lease Settlement"
    .To = ""   ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile


    ' Try to send
    Application.Visible = True
    .Display
  End With


  If IsCreated Then OutlApp.Quit  '<-- Quit Outlook if it was not already open
  Set OutlApp = Nothing  '<-- Release the memory of object variable




End Sub




<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">
</code>


----------



## Colmans

Milky, thanks for your help. It works great and i've been able to enhance it by expirmenting with your code.

The last thing I need is to be able to have the code insert the default outlook e-mail signature (non HTML) for the user executing the code. The current code uses the network user name which for me is a string of numbers and letters. I have been able to adjust the code so that no signature is used and this would require the user to manually attach their, but I wanted to avoid creating individual files for users and just have one network file.

Thanks in advance


----------



## MilkyTech

This is the simplest way, but the user's signature must be associated with the Default Outlook Account. 
 For some reason, the signature will not get added if you display the email after filling it out, so we just need to move .Display to the beginning of the email creation then add .Body to the end of the email body like so:


		Code:
__


 ' ### Prepare email and attach pdf created above ###
  With OutlApp.CreateItem(0)


    .Display     '<-- This needs to be first for the signature to be added

    .Subject = EmailSubject & "_ABN AMRO Lease Settlement"
    .To = ""   ' <-- Put email of the recipient here
    .CC = ""
    .Body = "Hello," & vbLf & vbLf _
          & "Please find attached a completed case review." & vbLf & vbLf _
          & "Thank you," & vbLf _
          & Application.UserName & vbLf & vbLf _
          & .Body       '<-- This adds the signature

    .Attachments.Add PdfFile



    Application.Visible = True

  End With


----------



## ZVI

Edit html code which are not displayed in forum, please wait


----------



## ZVI

Html tags are still not displayed properly...


----------



## ZVI

Below is the code to send active sheet as PDF with the default email signature.
It does not use a popular but blinking .Display  method for adding signature. No blinking at all.
There are Boolean configuration constants on the top of the code: IsHtml, IsDisplay, IsSilent  - reed the comments for more details.


		Rich (BB code):
__


Sub Attach_ActiveSheet_As_Pdf_With_Signature()
' ZVI:2016-05-31 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-4.html#post4537766
 
  ' --> User settings, change to suit
  Const IsHtml As Boolean = False     ' Change to True for HTML body of email
  Const IsDisplay As Boolean = False  ' Change to True to .Display instead of .Send
  Const IsSilent As Boolean = False   ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim MailSubject As String, PdfFile As String, s As String
  Dim HtmlSignature As String, Signature As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Subject of the email, choose one of two below lines
  'MailSubject = Range("A1") & " " & Date
  MailSubject = "Report on " & Date
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  ' Clean up the name of PDF file
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add %TEMP% path to the file name and limit too long name
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
  'Debug.Print PdfFile
 
  ' Try to delete PDF file for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Export activesheet as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and default signature
  With OutlApp.CreateItem(0)
   
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
   
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    If IsHtml Then HtmlSignature = .HTMLBody Else Signature = .Body
 
    ' Prepare e-mail (uncommenmt and fill the lines below)
    .Subject = MailSubject
    '.To = "..." ' <-- Put email(s) of the recipient(s) here
    '.CC = "..." ' <-- Put email of 'copy to' recipient(s) here
   
    ' Edit the body's text or html text as required
    If IsHtml Then
      ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
      ' HTML tag's brakets are not displayed properly in the forum post, thus replacing in s is used to fix this problem
      s = "(h3)(b)Dear Customer,(/b)(/h3)" _
          & "This e-mail was created by the code of this post - " _
          & "(a HREF=""http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-4.html#post4537766"")Attach_ActiveSheet_As_Pdf_With_Signature(/a)" _
          & "(br /)" _
          & "(b)The report is attached in PDF file(/b)"
      s = Replace(s, "(", "<")
      s = Replace(s, ")", ">")
      .HTMLBody = s & HtmlSignature
    Else
      .Body = "Dear Customer," _
          & vbLf & vbLf _
          & "This e-mail was created by the code of this post:" _
          & vbLf _
          & "http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-4.html#post4537766" _
          & vbLf & vbLf _
          & "The report is attached in PDF file" _
          & Signature
    End If
   
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
    
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Report on error or success
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## ncampo

Thanks for the amazing code! Worked perfect! I have 2 questions. 

1. Is there a way to insert yesterdays date in the subject line? I would like it to state the subject and then yesterdays date.

2. When the macro creates the PDF, Adobe Reader opens. It completes the email, but AR stays open. 

I have worked around both of these, but a permanent fix would be nice.
Again, thanks the the great code and great site!


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

ncampo said:


> ...Worked perfect! I have 2 questions...


You are welcome, and thank you for the feedback.

To your questions:

1. To insert the yesterday's date in the subject line just subtract one day (numerically it's equal to 1) from the *Date* like this:
MailSubject = "Report on " & *Date**– 1*

You may also use Format function, for example:
MailSubject = "Report on " & Format(*Date **- 1*,"mmm d, yyyy")

2. To prevent opening of Adobe Reader when macro creates the PDF there is special argument in the code of the post #159 (see below in *red*): 
.ExportAsFixedFormat ... *OpenAfterPublish:=False*

Please check this argument in your code

Regards,


----------



## Aru_Sidd

Works great. Kudos. 


ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


----------



## Aru_Sidd

Also had question as:
I have an excel file with sheets named as A, B, C, Main;
Main sheet has two columns viz., sheet_name and email_address;
sheet_name  email_address
A                  abc@xyz.com
B                  efg@xyz.com
and so on(list of all the sheets of the workbook it belongs to and respective email address for each sheet listed in email_address column).
I want the code to read the sheet_name from the Main sheet, go to respective sheet, convert to pdf and attach to email and send.
how could the mentioned code be modified? 
Help would be appreciated!
Thanks and regards,
Aru_Sidd


ZVI said:


> The template code for Excel 2007+ with its own PDF converter:


----------



## NVRensburg

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



Please can you help, I copied and pasted this code and edited it for my preferences, but it keeps telling me Email not sent?

Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  ' Not sure for what the Title is
  Title = Range("$B$59")

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = Range("$I$15")
    .To = "..." ' <-- Put email of the recipient here
    .CC = "creditors@junkshop.co.za" ' <-- Put email of 'copy to' recipient here
    .Body = "Good Day," & vbLf & vbLf _
          & " " & vbLf _
          & "Please find attached your payment remittance in PDF format." & vbLf & vbLf _
          & "Should you have any querier, please do not hesitate to contact me." & vbLf _
          & " " & vbLf _
          & "Kind Regards," & vbLf _
          & "Natasha van Rensburg," & vbLf _
          & "Creditors Administrator," & vbLf _
          & "Junk Shopping Centre," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0

  End With

  ' Delete PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

End Sub


----------



## bscott05

Hello,

I have tailored the original code posted by ZVI to suit my needs. Everything runs correctly until I get to the line " Attachment.add PdfFile" 

I receive a runtime error stating:
 Run-time error '-2147024894(80070002)':
Cannot find this file.  Verify the path and file name are correct.

here is my current code:


		Code:
__


Sub Compile_PDF_AND_EMAIL()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = ThisWorkbook.Sheets("Cover Sheet").Range("E18").Value
 
  ' Define PDF filename
  PdfFile = ThisWorkbook.Sheets("Cover Sheet").Range("B2").Text
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  'PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
  PdfFile = PdfFile & ".pdf"
 
  ' Export activesheet as PDF
  
With Workbooks("UW Production Report Full Raw Test")
    
    Workbooks("UW Production Report Full Raw Test").Activate

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    ActiveWorkbook.Sheets(Array("Daily UW Output")).Select
    
End With
    
    Workbooks("UW Production Report Cover Sheet").Activate
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = ThisWorkbook.Sheets("Cover Sheet").Range("E16").Value ' <-- Put email of the recipient here
    .CC = ThisWorkbook.Sheets("Cover Sheet").Range("E17").Value
    .Body = "Team," & vbLf & vbLf _
          & "Below you will find the " & ThisWorkbook.Sheets("Cover sheet").Range("E18").Value & vbLf & vbLf _
          & "Please let me know if you have any questions or concerns" & vbLf & vbLf _
          & "Thank you," & vbLf & vbLf
[B]    [COLOR="#FF0000"].Attachments.Add PdfFile[/COLOR][/B]
   
    ' Try to send
    On Error Resume Next
    '.Send
    .display
    Application.Visible = True
    'If Err Then
     ' MsgBox "E-mail was not sent", vbExclamation
    'Else
     ' MsgBox "E-mail successfully sent", vbInformation
    'End If
    'On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


any help will be greatly appreciated


----------



## CarlosPetersen

Vladimir, tks for your script. 

I Need to get the mail to from a cell on the sheet.

I did a test inserting my own email, and it returned "email not sent". What could be wrong?

Tks a lot!


----------



## ZVI

CarlosPetersen said:


> Vladimir, tks for your script.
> 
> I Need to get the mail to from a cell on the sheet.
> 
> I did a test inserting my own email, and it returned "email not sent". What could be wrong?
> 
> Tks a lot!


If email address is in the cell A1 then uncomment this line of the code:
*'.To = "..." ' <-- Put email(s) of the recipient(s) here*
and replace *"..."* by *Range("A1").Value* 
 so that line becomes:
*.To = Range("A1").Value*

To check what is wrong in the sending use *.Display*  instead of the *.Send* and try manual sending.


----------



## ZVI

ZVI said:


> *.To = Range("A1").Value*


See also example in post#152


----------



## ZVI

NVRensburg said:


> Please can you help, I copied and pasted this code and edited it for my preferences, but it keeps telling me Email not sent?





bscott05 said:


> Hello,
> 
> I have tailored the original code posted by ZVI to suit my needs. Everything runs correctly until I get to the line " Attachment.add PdfFile"
> 
> I receive a runtime error stating:
> Run-time error '-2147024894(80070002)':
> Cannot find this file.  Verify the path and file name are correct.
> ...
> any help will be greatly appreciated


Hope you've found the solution. Just for the case it's not I'd suggest using of more safety code, for example of post#43 where illegal symbols in PDF file name are replaced by the symbol "_", and length of PDF pathname is limited by 255 chars in this (in red) part of that code:


		Rich (BB code):
__


  ' Define PDF filename in TEMP folder
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  *For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"*


----------



## CarlosPetersen

Very thank you again Vladimir

Just a last question: and if I want to use on the subject, or email body, how can I use the script to take a cell content?

Thankyou!


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

CarlosPetersen said:


> Very thank you again Vladimir
> 
> Just a last question: and if I want to use on the subject, or email body, how can I use the script to take a cell content?
> 
> Thankyou!


Assuming the text of Subject is in the cell A2, then you can put it to the email like this (see in red):


		Rich (BB code):
__



  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
  
    ' Prepare e-mail
    *.Subject = Range("A2").Value* '<-- This copies text of subject from A2 to email
    .To = Range("A1").Value



Regards,


----------



## CarlosPetersen

Vladimir, thank you so much ofr your generosity for sharing your knowledgement with us. 

now its ok!


----------



## ZVI

CarlosPetersen said:


> Vladimir, thank you so much ofr your generosity for sharing your knowledgement with us.
> 
> now its ok!


Nice to know it works for you Carlos, welcome to the Board!


----------



## kratz101

Hi Everyone,

Appreciate everyone's work thus far in this thread it has got me 90% of the way into completing my project.

What I need to do now is be able to hide the sheet that is being converted to a PDF, is this possible?



		Code:
__


Sub AttachActiveSheetPDF()  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("I3")
 
  ' Define PDF filename
  PdfFile = "RMA Freight Booking"
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & Range("I3") & ".pdf"
 
  ' Export activesheet as PDF
  With Sheets("Freight Booking")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = "RMA Freight Booking"
    .To = "..." ' <-- Put email of the recipient here
    .CC = "customerservice@hendrickson.com.au" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "Please make the attached booking." & vbLf & vbLf _
          & "Regards," & vbLf _
          & "Despatch" & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Display
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## ZVI

kratz101 said:


> What I need to do now is be able to hide the sheet that is being converted to a PDF, is this possible?
> 
> 
> 
> Code:
> __
> 
> 
> ' Export activesheet as PDF
> With Sheets("Freight Booking")
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With


Hi and welcome to the Board!

Below of this line of the code:
*.ExportAsFixedFormat ...*
insert one more line:
*.Visible = xlSheetHidden*

Note: at least one sheet in workbook should stay unhidden


----------



## kratz101

Thanks for the quick response ZVI, the below works on the first run (sheet hides and export to email works) although on the second run (with the sheet still hidden) I get run-time error 5 - Invalid procedure call or argument.

To clarify I would like the sheet to remain hidden at all times, while still allowing export to PDF.



		Code:
__


  ' Export activesheet as PDF
  With Sheets("Freight Booking")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Visible = xlSheetHidden
  End With


----------



## ZVI

Well, then use this code modification:


		Rich (BB code):
__


  ' Export activesheet as PDF
  With Sheets("Freight Booking")
    .Visible = xlSheetVisible
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Visible = xlSheetHidden
  End With


----------



## ALhammadi

Hi All, Many thanks for the nice coding. 
I have a small question is it possible to capture the system date in the email ?


----------



## MilkyTech

Many possibilities.  Google "excel vba date".  This page is useful: http://www.globaliconnect.com/excel...-month-week-day-functions&catid=79&Itemid=475


----------



## Mindb85

Thanks for all of the great codes they've been all really helpful so far.

Is it possible to edit the attached code so that I can extract multiple sheets to PDF and attach them to the one email?



		Code:
__


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("G5")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = "Payroll Monthly Analysis"
    .To = Range("L3").Value
    .CC = Range("L4").Value
    .Body = "Hi," & vbLf & vbLf _
          & "Please find the latest payroll report attached" & vbLf & vbLf _
          & "Regards," & vbLf & vbLf
    .Attachments.Add PdfFile
       
    ' Try to send
    On Error Resume Next
    .Display
    Application.Visible = True
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


Any assistance is greatly appreciated.  I have looked through all of the previous replies and couldn't see anywhere that this issue had been addressed previously.

Regards 

Will


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

Do you mean all sheets should be in the attached PDF file or only some of them?


----------



## ZVI

The below code sends *Sheet1* and *Sheet3* in the attached single PDF file.
Those sheets are listed in *MySheets* constant in the top of the code, modify it as required. 
To send all sheets use *Const MySheets As Variant = 0* 
Signature is added to the bottom of email.


		Code:
__


[COLOR=darkblue]Sub[/COLOR] Attach_Sheets_As_Pdf_With_Signature()
[COLOR=green]' ZVI:2016-09-20 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-5.html#post4636652[/COLOR]
 
  [COLOR=green]' --> User settings, change to suit[/COLOR]
  [COLOR=darkblue]Const[/COLOR] MySheets [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR] = "Sheet1,Sheet3" [COLOR=green]' Use MySheets = 0 for all the sheets[/COLOR]
  [COLOR=darkblue]Const[/COLOR] IsDisplay [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR] = [COLOR=darkblue]True[/COLOR]           [COLOR=green]' Change to False to .Send instead of .Display[/COLOR]
  [COLOR=darkblue]Const[/COLOR] IsSilent [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR] = [COLOR=darkblue]False[/COLOR]           [COLOR=green]' Change to True to Send without the confirmation MsgBox[/COLOR]
  [COLOR=green]' <-- End of settings[/COLOR]
 
  [COLOR=darkblue]Dim[/COLOR] IsCreated [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] PdfFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], Signature [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] OutlApp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] char [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
 
  [COLOR=green]' Define PDF filename[/COLOR]
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  [COLOR=darkblue]If[/COLOR] i > Len(PdfFile) - 5 [COLOR=darkblue]Then[/COLOR] PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  [COLOR=green]' Clean up the name of PDF file[/COLOR]
  [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] char [COLOR=darkblue]In[/COLOR] Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  [COLOR=darkblue]Next[/COLOR]
  [COLOR=green]' Add %TEMP% path to the file name and limit too long name[/COLOR]
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
 
  [COLOR=green]' Try to delete PDF file for the case it was not deleted at debugging[/COLOR]
  [COLOR=darkblue]If[/COLOR] Len(Dir(PdfFile)) [COLOR=darkblue]Then[/COLOR] Kill PdfFile
 
  [COLOR=green]' Select sheets to be exported in the PDF (single) file[/COLOR]
  [COLOR=darkblue]If[/COLOR] MySheets = 0 [COLOR=darkblue]Then[/COLOR]
    [COLOR=green]' All sheets to PDF[/COLOR]
    Sheets.Select
  [COLOR=darkblue]Else[/COLOR]
    [COLOR=green]' Sheets listed in MySheets to PDF[/COLOR]
    Sheets(Split(MySheets, ",")).Select
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
  [COLOR=green]' Export the selected sheets as PDF to the temporary folder[/COLOR]
  [COLOR=darkblue]With[/COLOR] ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Select
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
 
  [COLOR=green]' Use the already open Outlook if possible[/COLOR]
  [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
  Set OutlApp = GetObject(, "Outlook.Application")
  [COLOR=darkblue]If[/COLOR] Err [COLOR=darkblue]Then[/COLOR]
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = [COLOR=darkblue]True[/COLOR]
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
  [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
 
  [COLOR=green]' Prepare email with PDF attachment and default signature[/COLOR]
  [COLOR=darkblue]With[/COLOR] OutlApp.CreateItem(0)
   
    [COLOR=green]' Add the attachment first for correct attachment's name with non English symbols[/COLOR]
    .Attachments.Add PdfFile
   
    [COLOR=green]' Get default email signature without blinking (instead of .Display method)[/COLOR]
    [COLOR=darkblue]With[/COLOR] .GetInspector: [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    Signature = .Body
 
    [COLOR=green]' Prepare e-mail (uncommenmt and fill the lines below)[/COLOR]
    .Subject = "Payroll Monthly Analysis"
    .To = Range("L3").Value
    .CC = Range("L4").Value
    .Body = "Hi," & vbLf & vbLf _
          & "Please find the latest payroll report attached" & vbLf & vbLf _
          & Signature
   
    [COLOR=green]' Try to send or just display the e-mail[/COLOR]
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
    [COLOR=darkblue]If[/COLOR] IsDisplay [COLOR=darkblue]Then[/COLOR] .Display [COLOR=darkblue]Else[/COLOR] .Send
   
    [COLOR=green]' Show error of .Send method[/COLOR]
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] IsDisplay [COLOR=darkblue]Then[/COLOR]
      [COLOR=green]' Return focus to Excel's window[/COLOR]
      Application.Visible = [COLOR=darkblue]True[/COLOR]
      [COLOR=green]' Report on error or success[/COLOR]
      [COLOR=darkblue]If[/COLOR] Err [COLOR=darkblue]Then[/COLOR]
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      [COLOR=darkblue]Else[/COLOR]
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] IsSilent [COLOR=darkblue]Then[/COLOR]
          MsgBox "E-mail successfully sent", vbInformation
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
 
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
 
  [COLOR=green]' Delete the temporary PDF file[/COLOR]
  [COLOR=darkblue]If[/COLOR] Len(Dir(PdfFile)) [COLOR=darkblue]Then[/COLOR] Kill PdfFile
 
  [COLOR=green]' Try to quit Outlook if it was not previously open[/COLOR]
  [COLOR=darkblue]If[/COLOR] IsCreated [COLOR=darkblue]Then[/COLOR] OutlApp.Quit
 
  [COLOR=green]' Try to release the memory of object variable[/COLOR]%


----------



## mahmed1

Hi ZVI, 

Awesome thread , there are so many pages on here so i was hoping you could help me  and advise which one suits best for my situation...

I am using excel 2013

I want to be able to email certain sheets as PDF but not the whole range
I have sheets called Dashboard and WeeklyInput
I want to be able to export range A1 to X500 as PDF from the dashboard sheet and range A1:D200 to export from sheet weekly
I want to then SetPrint are to these ranges and then print them also..

The PDF file should be titled Summary for and what the previous date was

My sheets have shapes and charts therefore i would want it to look exactly the same as it looks onmy excel sheets but as PDF file

Hopefully you can help me tweak your existing code to achieve this..

Many Thanks


----------



## ZVI

ZVI said:


> The below code sends *Sheet1* and *Sheet3* in the attached single PDF file.
> Those sheets are listed in *MySheets* constant in the top of the code, modify it as required.
> To send all sheets use *Const MySheets As Variant = 0*
> Signature is added to the bottom of email.


I repost the code here:


		Rich (BB code):
__


Sub Attach_Sheets_As_Pdf_With_Signature()
' ZVI:2016-09-20 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-5.html#post4636678
 
  ' --> User settings, change to suit
  Const MySheets As Variant = "Sheet1,Sheet3" ' Use MySheets = 0 for all the sheets
  Const IsDisplay As Boolean = True           ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = False           ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim PdfFile As String, Signature As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  ' Clean up the name of PDF file
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add %TEMP% path to the file name and limit too long name
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
 
  ' Try to delete PDF file for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Select sheets to be exported in the PDF (single) file
  If MySheets = 0 Then
    ' All sheets to PDF
    Sheets.Select
  Else
    ' Sheets listed in MySheets to PDF
    Sheets(Split(MySheets, ",")).Select
  End If
 
  ' Export the selected sheets as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Select
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and default signature
  With OutlApp.CreateItem(0)
  
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
  
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    Signature = .Body
 
    ' Prepare e-mail (uncommenmt and fill the lines below)
    .Subject = "Payroll Monthly Analysis"
    .To = Range("L3").Value
    .CC = Range("L4").Value
    .Body = "Hi," & vbLf & vbLf _
          & "Please find the latest payroll report attached" & vbLf & vbLf _
          & Signature
  
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
  
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Report on error or success
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## mahmed1

Thank you

Does this do the whole sheet as PDF (certain ranges are just there for calculation therefore these ranges dnt need to be exported as PDF..

I will therefore need certain ranges from the 2 sheets to be exported and then printed also, if its not too much, i will need to attach the workbook also 
reason why i need both is because certain managers just want to see the dashboard view (PDF) and certain managers want access to workbook


----------



## ZVI

Hi Mahmed,
Try this code. 
Modify constants in the top of the code according to their comments.


		Rich (BB code):
__


Sub Attach_Ranges_With_Signature()
' ZVI:2016-09-20 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-post4636746.html#post4636746
 
  ' --> User settings, change to suit
  Const Sh1 = "Dashboard"             ' Sheet1 to be attached in PDF
  Const Rng1 = "A1:X500"              ' The range of sheet1
  Const Sh2 = "WeeklyInput"           ' Sheet2 to be attached in that PDF too
  Const Rng2 = "A1:D200"              ' The range of sheet2
  Const IsAttachWb As Boolean = True  ' True to attach active workbook as well
  Const IsDisplay As Boolean = True   ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = False   ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim PdfFile As String, Signature As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Prepere Dashboard for PDF
  With Sheets(Sh1).Cells
    .EntireColumn.Hidden = True
    .EntireRow.Hidden = True
    With .Range(Rng1)
      .EntireColumn.Hidden = False
      .EntireRow.Hidden = False
    End With
  End With
 
  ' Prepere Dashboard for PDF
  With Sheets(Sh2).Cells
    .EntireColumn.Hidden = True
    .EntireRow.Hidden = True
    With .Range(Rng2)
      .EntireColumn.Hidden = False
      .EntireRow.Hidden = False
    End With
  End With
 
  ' Define PDF filename
  PdfFile = "Summary"
  ' Add %TEMP% path to the file name and limit too long name
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
 
  ' Try to delete PDF file for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Select sheets to be exported in the PDF (single) file
  Sheets(Split("Dashboard,WeeklyInput", ",")).Select
 
  ' Export the selected sheets as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Select
  End With
 
  ' Restore Dashboard for PDF
  With Sheets(Sh1).Cells
    .EntireColumn.Hidden = False
    .EntireRow.Hidden = False
  End With
 
  ' Retore Dashboard for PDF
  With Sheets(Sh2).Cells
    .EntireColumn.Hidden = False
    .EntireRow.Hidden = False
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and default signature
  With OutlApp.CreateItem(0)
  
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
    If IsAttachWb Then .Attachments.Add ThisWorkbook.FullName
  
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    Signature = .Body
 
    ' Prepare e-mail (uncommenmt and fill the lines below)
    .Subject = "Payroll Monthly Analysis"
    .To = Range("L3").Value
    .CC = Range("L4").Value
    .Body = "Hi," & vbLf & vbLf _
          & "Please find the latest payroll report attached" & vbLf & vbLf _
          & Signature
  
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
  
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Report on error or success
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## mahmed1

Hi ZVI,

Firstly i want to say thank you so so so much..

Honestly you dont know how helpful you have been..

I was hoping you could help me with the last bit to go 1 step further..

The top msnagers also like to see PowerPoint prentation slides that focus on each are. We have a default PowerPoint template that is used through the business..

Is it possible to have a PowerPoint reprentation on of each section into its own slides?

e.g 

I have named range area Work in progress..

A5:J30 (that is the range that holds my data and the charts)
A35:J55 (that holds another section with charts)etc..

I have several of these ranges named..

I have to every other day copy those ranges and show those sections on PowerPoint on its own slide (resize the image) for that section nicely on each slide so that the senior managers can go through each slide in their meetings..(I normally coppy the range as a picture and then paste into PowerPoint slide and resize) (sometimes the image looks blurry tho

Would that be possible...you would help my day to day job massively if i can automate this and i can imagine helping so many others also who will no doubt have the same problem..

If you can please come up with some code that will do this i am happy to even pay for this to show my appreciation- thank you


----------



## Mindb85

Thank you for your help!

The code works perfectly

Regards

Will


----------



## Mindb85

Hi everyone.

I'm happy with everything that the attached code does however is it possible to amend the email signature so that it retains the formatting?  It is currently coming through as plain text but it is necessary to retain the formatting due to the standardization of our corporate communications.


		Code:
__


[Sub Attach_Sheets_As_Pdf_With_Signature()
' ZVI:2016-09-20 [URL]http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-5.html#post4636678[/URL]
 
  ' --> User settings, change to suit
  Const MySheets As Variant = "SUMMARY,PAYROLL,MILEAGE,OVERTIME" ' Use MySheets = 0 for all the sheets
  Const IsDisplay As Boolean = True           ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = True           ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim PdfFile As String, Signature As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  ' Clean up the name of PDF file
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add %TEMP% path to the file name and limit too long name
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "" & PdfFile, 251) & ".pdf"
 
  ' Try to delete PDF file for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Select sheets to be exported in the PDF (single) file
  If MySheets = 0 Then
    ' All sheets to PDF
    Sheets.Select
  Else
    ' Sheets listed in MySheets to PDF
    Sheets(Split(MySheets, ",")).Select
  End If
 
  ' Export the selected sheets as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Select
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and default signature
  With OutlApp.CreateItem(0)
  
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
  
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    Signature = .Body
 
    ' Prepare e-mail (uncommenmt and fill the lines below)
    .Subject = "Payroll Monthly Analysis"
    .To = Range("I3").Value
    .CC = Range("I4").Value
    .Body = "Hi," & vbLf & vbLf _
 & "Please find the latest payroll report attached" & vbLf & vbLf _
 & Signature
  
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
  
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Report on error or success
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub
 
 
/CODE]

Regards

Will
Once again any assistance is greatly appreciated!


----------



## ZVI

Mindb85 said:


> Thank you for your help!
> 
> The code works perfectly
> 
> Regards
> 
> Will


I'm glad it has helped. Welcome to MrExcel Board!


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## mahmed1

Hi ZVI - thank you for your time and making so many of our daily tasks easy - thank you

Is there any chance you could help us with my emailIng PowerPoint query in post 187

if you could please help us with that, that would be awesome..i dont mind paying for it also..

Ps can a range which holds a chart and shapes be copied directly  in Outlook?

So say range a5:g45 had shapes and charts and we made a temp copy of this as picture to paste this in outlook body, can that be done?

1) Snapshot of this range onto the body of outlook
2) Email Workbook as attachment
3) Send PDF copy (code you provided)
4) Create PowerPoint Slides for each section

My goal is to have a summary of the dashboard data in outlook, a PowerPoint presentation for the senior managers, a PDF copy as a reference book and the workbook itself for editing purposes

If this is going to take too much of your time i dont mind paying for it but if you can help without me paying for it that would be awesome aswel


----------



## ZVI

Mindb85 said:


> ... is it possible to amend the email signature so that it retains the formatting?  It is currently coming through as plain text but it is necessary to retain the formatting due to the standardization of our corporate communications.


To use signature with formatted text  & picture, the .HTMLBody should be used in the code instead of the just .Body
Code in post #159 reflects both methods: using of HTML signature with HTML formatted message, and the plain text message with text of a signature.
Here is a mixed version of the code where plain text of the message is converted to a simple HTML code with full HTML signature


		Rich (BB code):
__


Sub Attach_Sheets_As_Pdf_With_HTMLSignature()
' ZVI:2016-09-21 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-post4637844.html#post4637844
 
  ' --> User settings, change to suit
  Const MySheets As Variant = "Sheet1,Sheet3" ' Use MySheets = 0 for all the sheets
  Const IsDisplay As Boolean = True           ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = False           ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim PdfFile As String, Signature As String, Message As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
  ' Clean up the name of PDF file
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add %TEMP% path to the file name and limit too long name
  PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
 
  ' Try to delete PDF file for the case it was not deleted at debugging
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Select sheets to be exported in the PDF (single) file
  If MySheets = 0 Then
    ' All sheets to PDF
    Sheets.Select
  Else
    ' Sheets listed in MySheets to PDF
    Sheets(Split(MySheets, ",")).Select
  End If
 
  ' Export the selected sheets as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Select
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and default signature
  With OutlApp.CreateItem(0)
  
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
  
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    Signature = .HTMLBody
 
    ' Prepare e-mail (uncommenmt and fill the lines below)
    .Subject = "Payroll Monthly Analysis"
    .To = Range("L3").Value
    .CC = Range("L4").Value
    Message = "Hi," & vbLf & vbLf _
            & "Please find the latest payroll report attached"

    .HTMLBody = Replace(Message, vbLf, Chr(60) & "br" & Chr(62)) & Signature
  
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
  
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Report on error or success
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## ZVI

mahmed1 said:


> Hi ZVI - thank you for your time and making so many of our daily tasks easy - thank you
> 
> Is there any chance you could help us with my emailIng PowerPoint query in post 187
> 
> if you could please help us with that, that would be awesome..i dont mind paying for it also..
> 
> Ps can a range which holds a chart and shapes be copied directly  in Outlook?
> 
> So say range a5:g45 had shapes and charts and we made a temp copy of this as picture to paste this in outlook body, can that be done?
> 
> 1) Snapshot of this range onto the body of outlook
> 2) Email Workbook as attachment
> 3) Send PDF copy (code you provided)
> 4) Create PowerPoint Slides for each section
> 
> My goal is to have a summary of the dashboard data in outlook, a PowerPoint presentation for the senior managers, a PDF copy as a reference book and the workbook itself for editing purposes
> 
> If this is going to take too much of your time i dont mind paying for it but if you can help without me paying for it that would be awesome aswel


Hi Mahmed,

Looks like all that is possible but requires some spare time which is not always happens.
Point 1 - Excel 2010+ uses Word application as an email editor, so technically this point seems can be done.
Point 2 - see post #186 
Point 3 - the same as above
Point 4 - seems it's out of the scope of this thread subject, if so then it's better to create new thread for it.
This part of the code reflects how to copy Excel's range as picture into the automated application PowerPoint:


		Rich (BB code):
__


  Range("A5:J30").CopyPicture Appearance:=xlScreen, Format:=xlPicture
  With objPowerPoint
    .Presentations.Add
    .ActiveWindow.View.Paste
  End With

But it's unclear if you stuck somewhere in your attempts of coding or the full of code is required.

Regards,


----------



## mahmed1

Hi ZVI,

Thank you once again..

I have no idea how to achieve point 1 and 4 therefore would need full code to get those working.. 

I really do appreciate all your help and would from the bottom of my heart be greatful if you could help us with this if you can when you are free..

The only reason why I didn't create a new thread is because i was on about the same topic as copying a range as picture and then pasting in each in slide in the powerpoint template 


I didnt want to duplicate things..

If you could have a look..that sould be so appreciated..

I wana buy you a drink from me to show my appreciation (this is not you making money or taking money against forum rules) - just a genuine thank you drink


----------



## mahmed1

Hi ZVI, once again thank you

I tested your picture code snippet and that definitely seems to be more down the line of what i need for the PowerPoint slides..

I had a slight issue with pasting it into powerpoint..

It would not let me execute the line of code to paste into powerpoint

I would also like to resize the picture to slide width or resized where its got some spacing around the image and pasted in the middle of the slide

A couple of other things ..I have a Powerpoint Template called Company Template

on this template i have 2 slides 

1 homepage slide which has 1 text box
and another slide which is the template slide that should be used throughout the presentation..on this slide there is only 1 text box..

Now what i would like to do is open this template presentation and on the homepage slide (1st slide) i would want to update the rext box to the value which is on Dashboard range A1

on the template slide what i would need to do is first update the textbox to the range i am copying so say my range name is Attendance...
the text box text should say attendance..i would then copy the range as pucture to this slide like the code you provided for the picture creation and then resize 

i would repeat this process again ie copy the template slide..fill in the text of the text box to the next range im copying (say its Incoming Volumes)..
the textbox text should say Incoming Volumes
copy the range and then resize

There are several of ranges i need to copy on each slide and the text box text is essentially the title/heading..I have the heading names for each section also ib dashboard sheet range (K1:K15) 15 sections to copy therefore would be creating 15 slides..

I really hope this makes sense..I really appreciate your help and this would help me massively creating the PowerPoint Report ...

Would need help on point 1 also (copy range which has shapes charts etc) and paste into the body of outlook

I am using excel 2013..

Thank you so much


----------



## ZVI

mahmed1 said:


> I was hoping you could help me with *the last* bit to go 1 step further.
> The top managers also like to see PowerPoint presentation slides that focus on each are. We have a default PowerPoint template that is used through the business..
> Is it possible to have a PowerPoint presentation on of each section into its own slides?





mahmed1 said:


> can a range which holds a chart and shapes be copied directly in Outlook?
> So say range a5:g45 had shapes and charts and we made a temp copy of this as picture to paste this in outlook body, can that be done?
> 1) Snapshot of this range onto the body of outlook
> 2) Email Workbook as attachment
> 3) Send PDF copy (code you provided)
> 4) *Create PowerPoint Slides for each section*
> My goal is to have a summary of the dashboard data in outlook, a PowerPoint presentation for the senior managers, a PDF copy as a reference book and the workbook itself for editing purposes


Hi Mahmed,
There is absolutely abnormal amount of posts in this thread. It is difficult even to read all posts to find a suitable/updated solution.
 The majority of a question came with a code only from page 1, though for me the later the post the better the code. 
 Of course someone may help you here in any question. But my participation in this thread is almost on helping questions of the thread's subject. That is, on "*VBA code to convert excel to pdf and email it as attachment*" like what are in your points 2 and 3 but not in other points.  
As to the code it is simple to attach to email any type of files like Presentation or Word document:
	
	
	
	
	
	




		Rich (BB code):
__


  .Attachments.Add PdfFile        '<-- This line present in the code for PDF
  .Attachments.Add PowerPointFile ' PowerPointFile is full path to the file of presentation
  .Attachments.Add WordFile       ' WordFile is full path to the file of Word document

But preparing contents of Presentation (or Word document) is another subject, there can be a lot of such of them, but why in this thread?
 I'd help you with a pleasure in code for PowerPoint, but out of this thread – you may create new thread, post your attempts of code, describe where you have stuck in and provide me (by PM) the link to that thread for participation.  And even if you have problems with coding and need in the ready to use example for the PowerPoint task (without explaining), then PM the details and I will prepare the sample for you, may be on the next week, and provide the link to download it.
Regards,


----------



## mahmed1

Thank you mate- I have created a new thread and posted some code and my attempt in there with an explanation

I am unable to PM you as its not allowing me to

This is thread I created

http://www.mrexcel.com/forum/excel-...ual-basic-applications-powerpoint-slides.html

Thank you for helping me


----------



## ZVI

mahmed1 said:


> Thank you mate- I have created a new thread and posted some code and my attempt in there with an explanation
> 
> I am unable to PM you as its not allowing me to
> 
> This is thread I created
> 
> http://www.mrexcel.com/forum/excel-...ual-basic-applications-powerpoint-slides.html
> 
> Thank you for helping me


 Nice, thank you! Private Messaging is now switched to all members, thanks for pointing me out it was not allowed.


----------



## Manish71

Hi,

I am using an macro which prints the active sheet, by changing the cell number b5 from the range of input given at the time of entry.

The macro I am using is as under

Sub PrintCopies_ActiveSheet()
    Dim CopiesCount As Long
    Dim CopieNumber As Long
    Dim Startchqno As Long
    CopiesCount = Application.InputBox("How many Copies do you want", Type:=1)
    Startchqno = Application.InputBox("Starting Chq No", Type:=1)

    For CopieNumber = Startchqno To (CopiesCount + Startchqno)
        With ActiveSheet
            'number in cell B5
            .Range("b5").Value = CopieNumber

            'number in the footer
            '.PageSetup.LeftFooter = CopieNumber & " of " & CopiesCount

            'Print the sheet
            .PrintOut

        End With
    Next CopieNumber
End Sub


Now i want to have an macro, wherein instead of printing the sheet, the active sheet is converted into PDF and mailed to cell with email ID at B16 and copy to B17 if not blank. Using outlook or gmail, with the subject as per field B7

Will appreciate help


----------



## Jeson Joshua

Hello,

I am very new to this VBA thing. Could any of you please help me with the codes to have different sheets in excel printed to PDFs and PDFs getting saved with same name as the sheet name? and then have it send through outlook to the same name ( i.e tab name). It would be a great help for me. Thankyou


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

Jeson Joshua said:


> Hello,
> 
> I am very new to this VBA thing. Could any of you please help me with the codes to have different sheets in excel printed to PDFs and PDFs getting saved with same name as the sheet name? and then have it send through outlook to the same name ( i.e tab name). It would be a great help for me. Thankyou


Hi, 
Does "different sheets" mean all sheets in the active workbook or some of them, or may be sheets in different workbooks?
Should all PDFs be attached to the single email or each of them have to be send separately?


----------



## Jeson Joshua

Hi Vladimir,

Thanks for the response. I get these workbook which has close to 60 Sheets in it and each sheet has data in it. And each data (Sheet) has to go to different person through email. All the sheets in that work book is named (person name) and that is where the email needs to be sent. And all the emails would have same subject line.

So to answer your question:

Different sheets mean all sheets in active workbook

And each pdf should go to different person. Like below:

 Instead of having sheet 1 Sheet 2 sheet 3.. and so on, the sheet is saved with name like John, Rudy, kayla and so on .. and the John pdf should be able to go to John vai outlook and Rudy's pdf to rudy and Kayla's to kayla email address. 

Hope it makes sense. 

Is it possible to do so?? and if it is, please could you help me on that. It will save my life. Apprecite all your help. 

Br.
Jeson


----------



## ZVI

Hi Jason,
Yes it's possible. 
Where email address should be get from for each person? 
This can be of in the cell of the sheet, for example.


----------



## Jeson Joshua

In Cell C7.


----------



## ZVI

This code sends each sheet as PDF file attached to email


		Rich (BB code):
__


Sub Send_Each_Sheet_As_Pdf_With_HTMLSignature()
' ZVI:2017-02-03 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-post4637844.html
 
  ' --> User settings, change to suit
  Const EmailCell = "C7"              ' Cell with email
  Const IsDisplay As Boolean = False  ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = True    ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim TempPath As String, PdfFile As String, Signature As String, Message As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
  Dim Sh As Worksheet
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    ' Create new instance of Outlook aplication
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' TEMP folder for PDF saving
  TempPath = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\"
   
  ' Turn off the screen updating
  Application.ScreenUpdating = False
 
  ' Main
  For Each Sh In ActiveWorkbook.Worksheets
   
    ' Prepare PDF file name
    Debug.Print Sh.Index, Sh.Name
    PdfFile = Sh.Name
    For Each char In Split("? "" / \ < > * | :")
      PdfFile = Replace(PdfFile, char, "_")
    Next
    PdfFile = Left(TempPath & PdfFile, 251) & ".pdf"
   
    ' Try to delete temporary PDF file
    If Len(Dir(PdfFile)) Then Kill PdfFile
   
    ' Export the selected sheets as PDF to the temporary folder
    'Sh.Select
    Sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
   
    ' Prepare email with PDF attachment and the default signature
    With OutlApp.CreateItem(0)
   
      ' Add the attachment first for correct attachment's name with non English symbols
      .Attachments.Add PdfFile
   
      ' Get default email signature without blinking (instead of .Display method)
      With .GetInspector: End With
      Signature = .HTMLBody
  
      ' Prepare e-mail (uncommenmt and fill the lines below)
      .Subject = "Personal Report"
      .To = Sh.Range(EmailCell).Value
      .CC = ""
      Message = "Dear " & Sh.Name & "," & vbLf & vbLf _
              & "Please find the latest report attached"
 
      .HTMLBody = Replace(Message, vbLf, Chr(60) & "br" & Chr(62)) & Signature
   
      ' Try to send or just display the e-mail
      On Error Resume Next
      If IsDisplay Then .Display Else .Send
   
      ' Show error of .Send method
      If Not IsDisplay Then
        ' Return focus to Excel's window
        Application.Visible = True
        ' Report on error or success
        If Err Then
          MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
          .Display
        Else
          If Not IsSilent Then
            MsgBox "E-mail successfully sent", vbInformation
          End If
        End If
      End If
      On Error GoTo 0
     
      ' Delete the temporary PDF file
      If Len(Dir(PdfFile)) Then Kill PdfFile
  
    End With
 
  Next
 
  ' Restore screen updating
  Application.ScreenUpdating = True
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## Jeson Joshua

Thanks a bunch!!! 

But when I use that code I am getting " Run - time error  '287': Application - defined or object - defined error.

.


----------



## ZVI

Hope the Outlook is installed on your PC. 
 1. What version of MS Office are you using?
2. And which code line causes the error? 
Then error message appears click on its [Debug] button - the debugger will highlight the problematic code line.


----------



## Jeson Joshua

Yes, Outlook is installed in my PC.
MS office 2013 version.

Problematic code line below :

*Signature = .HTMLBody*


----------



## ZVI

Thank you for the debugging,
It means that HTML Editor is not default on your Outlook.
Then try this version of the code:


		Rich (BB code):
__


Sub Send_Each_Sheet_As_Pdf_With_Signature()
' ZVI:2017-02-03 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-post4637844.html
 
  ' --> User settings, change to suit
  Const EmailCell = "C7"              ' Cell with email
  Const IsDisplay As Boolean = False  ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = True    ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim TempPath As String, PdfFile As String, Signature As String, Message As String
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
  Dim Sh As Worksheet
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    ' Create new instance of Outlook aplication
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' TEMP folder for PDF saving
  TempPath = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\"
   
  ' Turn off the screen updating
  Application.ScreenUpdating = False
 
  ' Main
  For Each Sh In ActiveWorkbook.Worksheets
   
    ' Prepare PDF file name
    PdfFile = Sh.Name
    For Each char In Split("? "" / \ < > * | :")
      PdfFile = Replace(PdfFile, char, "_")
    Next
    PdfFile = Left(TempPath & PdfFile, 251) & ".pdf"
   
    ' Try to delete temporary PDF file
    If Len(Dir(PdfFile)) Then Kill PdfFile
   
    ' Export the selected sheets as PDF to the temporary folder
    'Sh.Select
    Sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
   
    ' Prepare email with PDF attachment and the default signature
    With OutlApp.CreateItem(0)
   
      ' Add the attachment first for correct attachment's name with non English symbols
      .Attachments.Add PdfFile
   
      ' Get default email signature without blinking (instead of .Display method)
      With .GetInspector: End With
     
      Signature = .Body
  
      ' Prepare e-mail (uncommenmt and fill the lines below)
      .Subject = "Personal Report"
      .To = Sh.Range(EmailCell).Value
      .CC = ""
      Message = "Dear " & Sh.Name & "," & vbLf & vbLf _
              & "Please find the latest report attached"
 
      .Body = Message & Signature
   
      ' Try to send or just display the e-mail
      On Error Resume Next
      If IsDisplay Then .Display Else .Send
   
      ' Show error of .Send method
      If Not IsDisplay Then
        ' Return focus to Excel's window
        Application.Visible = True
        ' Report on error or success
        If Err Then
          MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
          .Display
        Else
          If Not IsSilent Then
            MsgBox "E-mail successfully sent", vbInformation
          End If
        End If
      End If
      On Error GoTo 0
     
      ' Delete the temporary PDF file
      If Len(Dir(PdfFile)) Then Kill PdfFile
  
    End With
 
  Next
 
  ' Restore screen updating
  Application.ScreenUpdating = True
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## Jeson Joshua

Thanks for the updated code. 

I tried with the new code but I could see the same line giving the error.

Below is the error:

 Signature = .Body.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

Does an auto signature set on your Outlook?
If not then just comment that line: 'Signature = .Body
and edit the Message = "Text of the email body" accordingly.


----------



## Jeson Joshua

Yes, Auto signature is set on my outlook.

Also, Now this is the debug coming up:

Sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


----------



## ZVI

Jeson Joshua said:


> ...MS office 2013 version.


Note, just for the case: code will not work on Home or Student editions because CreateObject() method is not supported by those versions.


----------



## ZVI

Jeson Joshua said:


> Yes, Auto signature is set on my outlook.


Please try commenting *'Signature = .Body* code line for debugging purpose.


----------



## Jeson Joshua

It is working. Wohoooo.... Thanks a million man.. You are the real MVP.. Appreciate it.


----------



## ZVI

Jeson Joshua said:


> It is working. Wohoooo.... Thanks a million man.. You are the real MVP.. Appreciate it.


I'm happy we have sorted this out!


----------



## Marhier

Good day to you all.
Sorry to intrude on this thread, but I am having a similar issue I was hoping someone might be able to help me with; I thought best not to post a _new _thread?

The code I'm using takes the current worksheet, exports it as a .pdf, brings up the 'Save As' box and once saved, a message pops up saying:
_"Copy saved. An email will now be created."_.

The issue I'm having is, I can't for the life of me get it to open up an email with the .pdf attached.

Please note that I'd like it to send via the user's default mail client, as the users accessing this file are either on Outlook or Lotus Notes etc.



		Code:
__


Sub ExporttoPDF()Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler


Set wbA = ActiveWorkbook
Set wsA = ActiveSheet


myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")
        
    MsgBox "Copy saved. An email will now be created." _
      & vbCrLf _
      & myFile


If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True


End If


exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub[CODE]


Any help would be greatly appreciated.
Thank you.
:)


----------



## safy89

Hi All!

Great Code, Big Thanks!
Can we make that the message don't change the text form?

I use this:

  With OutlApp.CreateItem(0)
    .Attachments.Add PdfFile


      With .GetInspector: End With
      Signature = .HTMLBody
    ' Prepare e-mail

    .Subject = Title
    .To = Range("C8") ' <-- Put email of the recipient here
    .CC = "teleki.zsuzsanna@aco.hu; nemeth.gabor@aco.hu" ' <-- Put email of 'copy to' recipient here
    Message = "Tisztelt " & Range("C7") & "!" & vbLf & vbLf _
            & "Csatoltan küldöm a telefonon is említett, szerződés szerinti teljesítés igazolásunkat!" & vbLf & vbLf _
            & "Legyenek szívesek cégszerűen aláírva, digitálisan is megküldeni részemre, és Teleki Zsuzsanna kolléganőm részére!" & vbLf & vbLf _
            & "Köszönöm!"
    .HTMLBody = Replace(Message, vbLf, Chr(60) & "br" & Chr(62)) & Signature

It works great, make everything I want, it has one problem, it change the message text style. How can I make that it use the original text style?

Thanks for answers!

Safy89


----------



## Padthelad

ooopppppppssssssssssss


----------



## Jeson Joshua

Hi MVP ,

I came across the same case but this time I dont need the sheets to get converted to PDF but I need each sheet itself with other details remaining the same. I tried to change few things in the coding with it isnt working.

Could you please help?

Thank you.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## mikeflo94

Hello Everyone,

Great Code by the way MVP. Thank you so much. I been reading the entire thread and try a few things but nothing seems to work. I just need to add a custom pdf tittle that could be set in the vba code or in a cell that I can link to the vba code. And how do I add the default signature from outlook to show in the email. 

Hope someone can help me out. Thank you.


----------



## mikeflo94

mikeflo94 said:


> Hello Everyone,
> 
> Great Code by the way MVP. Thank you so much. I been reading the entire thread and try a few things but nothing seems to work. I just need to add a custom pdf tittle that could be set in the vba code or in a cell that I can link to the vba code. And how do I add the default signature from outlook to show in the email.
> 
> Hope someone can help me out. Thank you.



OKay So I got this resolved. Is there a way to save the pdf file in a specific location after the emails are send? or even to the same folder where the workbook is saved? 

Thank you.


----------



## poochy16

Hi all

Code is working great for me, with one little hiccup. My temp PDF file that's being emailed is ~1,000 pages long, despite only having the data I want to send on the first page. I've been trying to figure out the root cause with little success. Is it possible that I simply have the print area defined incorrectly? 

Thanks in advance


----------



## mikeflo94

You might want to set the Print Area to only the range you want to send.


----------



## mikeflo94

Is there away to send the file as an excel file and not as pdf?


----------



## Mike_Hall_SP_PA

Afternoon ZVI.
I have been playing with a VBA that when I click a button in excel it activates the macro that sends the active sheet as a pdf to two pre-defined addresses. I am using Office 2010 Pro. It worked once then I now receive a Run-time error '2147024773 (8007007b)':
Document not saved.
The code I used actually looks to be identical to the one on page one. 
The code is below, the section highlighted *BOLD* is where the debugger stops. It will not allow me to step past either.
The excel file is saved on my desktop.
Any help would be greatly appreciated, thanks in advance


		Code:
__


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("A1")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & Format(Now, "MM-DD-YYYY HH:mm:ss") & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
[B]    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False[/B]
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = "email1@email.com" ' <-- Put email of the recipient here
    .CC = "email2@email.com" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format. " & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub
[CODE]


----------



## ZVI

Mike_Hall_SP_PA said:


> Afternoon ZVI.
> I have been playing with a VBA that when I click a button in excel it activates the macro that sends the active sheet as a pdf to two pre-defined addresses. I am using Office 2010 Pro. It worked once then I now receive a Run-time error '2147024773 (8007007b)':
> Document not saved.
> The code I used actually looks to be identical to the one on page one.


Hi Mike,

 Please try a more safe version of the code in the post #43 with description of possible problems (see points 2, 3, 4), and let us know whether the problem is solved or not.

Regards


----------



## Mike_Hall_SP_PA

Thanks Vladimir,
I was just about to respond as I got it to work on my own, I even got the date appended to the name of the file when it emailed. My part that I am now stuck on is I am guessing simpler. I also need the time added to the name of the file. Anytime I change the "format" code it gives an error. Here is what I am using:


		Code:
__


PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & FormatDateTime(Now, 1) & "_" & ".pdf"

I have attempted to change the 1 to a 4 to see if it would just put the time in, and I get the same debug error.
Ideas?
thanks
Mike


----------



## ZVI

Try this: 
PdfFile = PdfFile & "_" & Format(Now, "yyyyddmm_hhmmss") & ".pdf"

Please pay your attention on the fact that symbol ":" from FormatDateTime is illegal for file name


----------



## janarocky

ZVI said:


> Try this:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF_01()
> Dim IsCreated As Boolean
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> Title = "Request Form for " & Range("A1").Value
> PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"
> 
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "See the attached requiest in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> Application.Visible = True
> .Display
> End With
> 
> ' Quit Outlook if it was not already open
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub




Hi Sir,

            This is working perfectly. I just need one more thing. How to add a excel range into outlook body. The range is in sheet2. A1:D56. 
I want this range to be pasted at outlook body as unformatted text.

Please advice.

Thanks in advance.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## Mike_Hall_SP_PA

ZVI said:


> Try this:
> PdfFile = PdfFile & "_" & Format(Now, "yyyyddmm_hhmmss") & ".pdf"
> 
> Please pay your attention on the fact that symbol ":" from FormatDateTime is illegal for file name





Thanks a million Vladimir!

works perfectly even with my small format change: 


		Code:
__


PdfFile = PdfFile & "_" & Format(Now, "mm.dd.yyyy_HHMM") & ".pdf"



Thanks again!


----------



## Me_In_Va

I have been using this code to create a PDF file from a range. It was working for a while, right up until my company switched us to Excel 2016. The line with ".ExportAsFixedFormat..." is not working anymore. Is this something that others have run into when using Excel 2016? I have been looking for a way to get this funtion working again. Thanks.


----------



## luckyearl

Hi ZVI

Using your Code on post#159, works flawlessly. Have customised pdffile name based on cell value & date. Just wondering if I cud save the pdf in a folder on desktop folder (not desktop itself). Please suggest

Thank you


----------



## ZVI

luckyearl said:


> Using your Code on post#159, works flawlessly. Have customised pdffile name based on cell value & date. Just wondering if I cud save the pdf in a folder on desktop folder (not desktop itself). Please suggest


Hi,

Instead of this code line


		Rich (BB code):
__


   PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"

Try using those lines:


		Rich (BB code):
__


   Const MyFolder = "Test" ' Name of the Folder on Desktop
   PdfFile = Left(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & MyFolder & "\" & PdfFile, 251) & ".pdf"

Notes: 
1. Replace "Test" by actual name of the folder on your Desktop.
2. To not delete PDF-file don't use (just comment) this part on the bottom of the code:


		Rich (BB code):
__


  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile

Regards


----------



## lilchief

Hi guys!

I tried to post in advanced mode but it might have failed. Therefore, if my post id duplicated, I am sorry for it and  will delete the post if noe one does it before me.

This is my first post and I must say that I am impressed with the sharing here on this forum! Vladimir and the others are really nice in helping out n00bs like me. Thank you!

As others have, I used the base code from 2013 andtweaked it a bit. it all works, but the three issues that are remaining, I cannot find out and therefore need to ask for help. I was initially hoping to complete this earlier and showing it to my boss tomorrow before the weekend. My n00b skills however, thought different and I am now 4 hours overtime on my spare time to fix this. =P

Also, if I have not detected that my answers already have been given in the forum, I am sorry for reposting. I am a bit tired after 12hrs at work =/

Here are my 3 last issues:

- The attached filed to the email is the original Excel file, not the exported PDF. How can I change it to attach the exported pdf?
- After sending the email, the Kill Pdf cmd fails. Is that because the attached file is not PDF?
- The three different macro buttons underneath the form joins in on the PDF on page 2. How may I change it to only export the first page? This one I expect is tricky =/

Here is my code:


Private Sub CommandButton2_Click()
Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  ' Not sure for what the Title is
  Title = Range("A1")

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Ron Holan\Desktop" & ActiveSheet.Range("C9").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = "Budget offer for FRS from Bioteknikk AS"
    .To = " " & ActiveSheet.Range("F10").Value & " " '
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Bcc = " [WORK EMAIL]" ' <-- Put email of ' blind copy to' recipient here
    .Body = "Hi, " & ActiveSheet.Range("F9").Value & ", " & vbLf & vbLf _
          & " " & vbLf _
          & "Attached you will find our budgett offer regarding the FRS as discussed. If you have any questions, please do not hesitate to contact us. We are looking forward to cooperate with you." & vbLf & vbLf _
          & "Best regards," & vbLf _
          & " " & ActiveSheet.Range("D46").Value & " " & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0

  End With

  ' Delete PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing
End Sub


----------



## ZVI

lilchief said:


> Here are my 3 last issues:
> 
> 1. The attached filed to the email is the original Excel file, not the exported PDF. How can I change it to attach the exported pdf?
> 2. After sending the email, the Kill Pdf cmd fails. Is that because the attached file is not PDF?
> 3. The three different macro buttons underneath the form joins in on the PDF on page 2. How may I change it to only export the first page? This one I expect is tricky =/



Hi Lilchief, Welcome to MrExcel community!

The answers to your good questions are as follows:

1. The backslash symbol should be used after the "C:\Users\Ron Holan\Desktop"
2. Kill can't delete PDF file because it's exclusively open in Adobe Viewer by OpenAfterPublish:=True, use False instead.
3. To print only page 1 use IgnorePrintAreas:=Try and From:=1, To:=1 parameters.

Below is your code with all above issues fixed:



		Rich (BB code):
__


Private Sub CommandButton2_Click()
 
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String
  Dim OutlApp As Object
  Dim char As Variant
 
  ' Define PDF filename
  PdfFile = Range("C9").Value
  ' Replace unallowed symbols by the underscore char
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add %TEMP% path to the file name and limit its too long pathname if happen
  PdfFile = Left(Environ("TEMP") & "\" & PdfFile, 251) & ".pdf" '
 
  ' Export an active sheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, _
                         Filename:=PdfFile, _
                         Quality:=xlQualityStandard, _
                         IncludeDocProperties:=True, _
                         IgnorePrintAreas:=False, _
                         From:=1, To:=1, _
                         OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
 
    ' Prepare e-mail
    .Subject = "Budget offer for FRS from Bioteknikk AS"
    .To = Range("F10").Value & " "  '
    .CC = ""                ' <-- Put email of 'copy to' recipient here
    .Bcc = "[WORK EMAIL]"  ' <-- Put email of ' blind copy to' recipient here
    .Body = "Hi, " & ActiveSheet.Range("F9").Value & ", " & vbLf & vbLf _
          & " " & vbLf _
          & "Attached you will find our budgett offer regarding the FRS as discussed. If you have any questions, please do not hesitate to contact us. We are looking forward to cooperate with you." & vbLf & vbLf _
          & "Best regards," & vbLf _
          & " " & ActiveSheet.Range("D46").Value & " " & vbLf & vbLf
    .Attachments.Add PdfFile
 
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release memory of the object variable
  Set OutlApp = Nothing
 
End Sub

Best Regards,


----------



## lilchief

Hi Vladimir! 

Thank you for your reply this late. 

I tried to do as you said, but initially it gave the same effect, unfortunately. The original Excel file is still attached (and is in a share point location and therefore wont show, but I still need it in pdf for obvious reason). I also got a bit confused if you ment "IgnorePrintAreas:=Try" or as you placed in the code "=False".

Another thing that I started wondering about, does the other two buttons have som sort of wierd relations to each other? They're all sepereated by the line and the "Private Sub Commend" / "End Sub" and I would assume they would not have any connection. Either way, Vladimir. I really appiriciate your help, I really do!

Here are the errors I got after the "normal ones" to begin with:

- Run Time error '53' and when debugged, it goes to the Kill PDF and highlights it. This is the same error I got before I posted and even though bot the "To" and "Bcc:" recipent recieves email, the PDF is not attached. 
- Then I did my best to copy your code directly to mine and then I got "Runtime Error 2147024894 (80070002) - Cannot locate file. Check if file path and file name is correct".


Here is the code with your edits:

Private Sub CommandButton2_Click()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  ' Not sure for what the Title is
  Title = Range("A1")

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, _
                         Filename:="C:\Users\Ron Holan\Desktop" & ActiveSheet.Range("C9").Value & ".pdf", _
                         Quality:=xlQualityStandard, _
                         IncludeDocProperties:=True, _
                         IgnorePrintAreas:=False, _
                         From:=1, To:=1, _
                         OpenAfterPublish:=False
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = "FRS Budsjettilbud fra Bioteknikk AS"
    .To = " " & ActiveSheet.Range("F10").Value & " " '
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Bcc = "ron@bioretur.no" ' <-- Put email of ' blind copy to' recipient here
    .Body = "Hi, " & ActiveSheet.Range("F9").Value & ", " & vbLf & vbLf _
          & " " & vbLf _
          & "Attached you will find our budgett offer regarding the FRS as discussed. If you have any questions, please do not hesitate to contact us. We are looking forward to cooperate with you." & vbLf & vbLf _
          & "Best regards," & vbLf _
          & " " & ActiveSheet.Range("D46").Value & " " & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0

  End With

  ' Delete PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

End Sub


----------



## ZVI

Ny apologizing for "IgnorePrintAreas:=*Try*" it was my typo, I meant that "IgnorePrintAreas:=*True*" shouldn't be used in case the only the 1st page is expected in the PDF.

In your code this -  Filename:="C:\Users\Ron Holan\Desktop" is incorrect,
should be Filename:="C:\Users\Ron Holan\Desktop*\*" - see my point 1 in the post #236 .

Here is the testing code, please try it and let me know details about messages and the error code line.



		Rich (BB code):
__


Private Sub CommandButton2_Click()
 
   ' --> User settings, change to suit
  Const IsDisplay As Boolean = True           ' Change to False to .Send instead of .Display
  Const IsSilent As Boolean = False           ' Change to True to Send without the confirmation MsgBox
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String
  Dim OutlApp As Object
  Dim char As Variant
 
  ' Define PDF filename
  PdfFile = Range("C9").Value
  ' Check filename in C9
  If Len(Trim(PdfFile)) = 0 Then
    MsgBox "Name of PDF file is not found in C9", vbCritical, "Exit"
    Range("C9").Select
    Exit Sub
  End If
  ' Replace unallowed symbols by the underscore char
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add %TEMP% path to the file name and limit too long pathname
  PdfFile = Left(Environ("TEMP") & "\" & PdfFile, 251) & ".pdf"
 
  ' --> FOR DEBUG ONLY, Check PdfFile
  MsgBox "PdfFile will be created here: " & vbLf & PdfFile
  If Len(Dir(PdfFile)) > 0 Then
    On Error Resume Next
    Kill PdfFile
    If Err Then
      MsgBox "PDF file is already in use:" & vbLf _
           & PdfFile & vbLf _
           & "Please close all Adobe windows and try again", vbCritical, "Exit"
      Exit Sub
    End If
    On Error GoTo 0
  End If
  ' <--
 
  ' Export an active sheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, _
                         Filename:=PdfFile, _
                         Quality:=xlQualityStandard, _
                         IncludeDocProperties:=True, _
                         IgnorePrintAreas:=False, _
                         From:=1, To:=1, _
                         OpenAfterPublish:=False
  End With
 
  ' --> FOR DEBUG ONLY, Check PdfFile
  If Len(Dir(PdfFile)) = 0 Then
    MsgBox "This PDF file was not created for unknown reason:" & vbLf _
          & PdfFile, vbCritical, "Exit"
    Exit Sub
  End If
  ' <--
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
 
    ' Prepare e-mail
    .Subject = "Budget offer for FRS from Bioteknikk AS"
    .To = Range("F10").Value & " "  '
    .CC = ""                ' <-- Put email of 'copy to' recipient here
    .Bcc = "[WORK EMAIL]"  ' <-- Put email of ' blind copy to' recipient here
    .Body = "Hi, " & ActiveSheet.Range("F9").Value & ", " & vbLf & vbLf _
          & " " & vbLf _
          & "Attached you will find our budgett offer regarding the FRS as discussed. If you have any questions, please do not hesitate to contact us. We are looking forward to cooperate with you." & vbLf & vbLf _
          & "Best regards," & vbLf _
          & " " & ActiveSheet.Range("D46").Value & " " & vbLf & vbLf
   
     .Attachments.Add PdfFile
 
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
  
    ' Show error of .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Report on error or success
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release memory of the object variable
  Set OutlApp = Nothing
 
End Sub

 And just for the case try to save Excel file locally before running this code to exclude SharePoint influence.
What is version of your Excel?


----------



## lilchief

Eureka!! <3 \o/
Thank you Valdimir!! :D

Our Excel version is 2016 - with a Office365 subscription. 

Nice feature to add the file path. My boss is ..wel...not a tech wonder =P I think it is nice to have until they think of it as a nuisance and want me to deactivate it.  If I would deactivate it, should I delete the line:

MsgBox "PdfFile will be created here: " & vbLf & PdfFile    

..since it does not have any True/False operator. 

I also tried to change the file path under .ExportAsFixedFormat , but it did not like it. I need to be able to later move the file to sharepoint. Where is it possible to change the file path? It will be C:\User\User-Name\Desktop\BudgetOffer\ [FILENAME]

With your new code, I assume I could write     Range("C9").Value   insted of filename?


----------



## lilchief

I just reaalized, I might not need to store it on whatever computer the file is on. The file is attached to all recipents and can be downloaded from there.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## Maticiuc

Hi,

When the macro send the email, it's possible to include in email a picture with data?


----------



## madpirate

HI Guys ,
I have read through most of the posts here and unless I missed it -- (eyeball exhaustion)  I have seen some really close to what I have been trying to find but just missing the mark.

Please of possible could someone show me a code that;

1 I have a workbook with multiple worksheets (14)
2 I need to be able to select 5 or 6 of those worksheets
3 Convert each to its own pdf using the sheet name and creation date as the PDF name
5 Attach each sheet to ONE outlook email
6 Send it to 2 addresses.

Office 16 - 365 Vesrion

Many thanks in advance


I have tried a few Macros however with my sad skill set have failed spectacularly


----------



## sreekanth569

Dear ZVI,
Thanks for the code. It worked for me
But when I'm executing the same code on second day. It's throwing some error like file path doesn't exist(i didn't remember the exact error).
When i click debug on error dialog, it is navigating me to
.attachments.Add PdfFile

Anything I've to do to get rid of that error.


----------



## natiman77

Dear Zvi , 
i tried your code and it is work well , 
i have two qustions, 
1 . how can i set the macro to make this operation for each sheet sapertly , means that it will built each e-mail for each sheet with the relevant PDF with email adress that i will mention on B1 in each sheet for example.
2. how can i choose range for each sheet the will be  PDF file in attachment ?

thank you for your assis , 

below you can fint the code that i used .


		Code:
__


sub try1()
  Dim IsCreated As Boolean
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  Title = Range("A1")
 
 
  Title = "Request Form for " & Range("A1").Value
  PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "" & Title & "1.pdf"
 
 
  With Sheets("sheet1")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  With OutlApp.CreateItem(0)
   
    .Subject = Title
    .To = Range("B1")
    .CC = Range("B2")
    .Body = Range("B1") & vbLf & vbLf _
          & "See the attached requiest in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    Application.Visible = True
    .Display
  End With
 
  If IsCreated Then OutlApp.Quit
 
  Set OutlApp = Nothing
 
End Sub


----------



## Kilhuch

Dear, 

Thanks a lot for all explanation, it has been very usefull. Unfortunately, when I'm using this code, I have a runtime error 5: Invalid procedure or argument, for the following line: 
.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

He is giving an issue with the type but as it is excel 2010, I was not expecting any issue. 
What could be the reason that I have a runtime error?

Thanks for the support !


----------



## Mcfg007

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



Hi I have tried your code and works well, but could you tell me how can I specify which sheets and the range on each sheet to email as a PDF?


----------



## Colmans

Amend Export Active Sheet with the following - and amend sheet names accordingly.

' ### Export ActiveSheet to PDF ###
  Dim currentSheet As Worksheet
  With ActiveWorkbook
  Set currentSheet = .ActiveSheet
  .Worksheets(Array(currentSheet.Name, "Sheet1", "Sheet2", "Sheet3", "Sheet4")).Select
   .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With


----------



## Mcfg007

Colmans said:


> Amend Export Active Sheet with the following - and amend sheet names accordingly.
> 
> ' ### Export ActiveSheet to PDF ###
> Dim currentSheet As Worksheet
> With ActiveWorkbook
> Set currentSheet = .ActiveSheet
> .Worksheets(Array(currentSheet.Name, "Sheet1", "Sheet2", "Sheet3", "Sheet4")).Select
> .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With



Great thank you for perfectly, will need to twick a few things but should be ok.


----------



## jterrell

Is there a way to edit this code so that after the .pdf is attached to Outlook that it stops to enable you to attach other documents?


----------



## Hazelnut

Hi Michael;

Can you assist me with my code? I'm not that great at VBA code, but what I would like to do is have a pdf file created from my Excel 2010 worksheet based on specific cell input and then automatically emailed to a specific user. When the amount populates in cell P20, it sends an email with the file as an excel file still and the file is blank. Your help is greatly appreciated!! My code is below:


		Rich (BB code):
__


Private Sub Worksheet_Change(ByVal Target As Range)
 Dim xRgPre As Range
 On Error Resume Next
 If Target.Cells.Count > 1 Then Exit Sub
 Set xRg = Range("P20")
 Set xRgPre = xRg.Precedents
 If xRg.Value > 2999.99 Then
 If Target.Address = xRg.Address Then
    Call Mail_small_Text_Outlook
 ElseIf (Not xRgPre Is Nothing) And (Intersect(Target, xRgPre).Address = Target.Address) Then
 Call Mail_small_Text_Outlook
 End If
 End If
 End Sub
 Sub PDF()
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 "C:\Desktop\OrderForm.pdf", Quality:=xlQualityStandard, _
 IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
 True
 End Sub
 Sub Mail_small_Text_Outlook()
 Dim xOutApp As Object
 Dim xOutMail As Object
 Dim xMailBody As String
 Set xOutApp = CreateObject("Outlook.Application")
 Set xOutMail = xOutApp.CreateItem(0)
 xMailBody = "Attached is the order form." & vbNewLine & vbNewLine & _
 "Please contact me with any questions." & vbNewLine & _
 "Have a wonderful rest of your day!"
 On Error Resume Next
 With xOutMail
    .To = hazelnut@gardner.com
    .CC = ""
    .BCC = ""
    .Subject = "Order Form"
    .Body = xMailBody
    .Attachments.Add ThisWorkbook.FullName
    .Send
 End With
 On Error GoTo 0
 Set xOutMail = Nothing
 Set xOutApp = Nothing
 End Sub


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## Peter_SSs

Anybody wishing to respond to the previous post, please do so in this thread.

@ Hazelnut
We don't want to end up with 2 or more sets of people trying to solve the same problem, not knowing that their time may be wasted if the problem was already solved in another thread. Please refer to #12  of the Forum Rules and points 6 & 7 of the Forum Use Guidelines.


----------



## Hazelnut

Sorry, I was just trying to get an answer to the coding question. Oh well.


----------



## Hazelnut

When I use this code I receive a Run-time error '70': Permission denied. It creates the pdf and sends the email, but not sure why I'm getting this error. If I click on debug it takes me to the line "Kill PdfFile". I've tried removing that line and all the lines below it other than End Sub and nothing fixes it. Could you provide a fix for this issue? Thanks much! 



ZVI said:


> Try this:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF_01()
> Dim IsCreated As Boolean
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> Title = "Request Form for " & Range("A1").Value
> PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"
> 
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "See the attached requiest in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> Application.Visible = True
> .Display
> End With
> 
> ' Quit Outlook if it was not already open
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


----------



## ZVI

Hazelnut said:


> When I use this code I receive a Run-time error '70': Permission denied. It creates the pdf and sends the email, but not sure why I'm getting this error. If I click on debug it takes me to the line "Kill PdfFile". I've tried removing that line and all the lines below it other than End Sub and nothing fixes it. Could you provide a fix for this issue? Thanks much!


Hi, 
Such error can happen in case PdfFile has been previously open in Acrobat because Acrobat locks that file and file can't be deleted/updated. Close all Acrobat windows with PdfFile before running the code. Or add timestamp to the name of PdfFile to guarantee its unique name.
Also be sure that parameter OpenAfterPublish:=*False* is present in the code line with .ExportAsFixedFormat


----------



## imatjazz

Hi Michael,

I tried to run your code but got a compile error for the PdfDistiller: "User-defined type not defined". Do i need to install a third party PDF export plugin? 

Thanks,


----------



## Peter_SSs

imatjazz said:


> Hi Michael,
> 
> I tried to run your code but got a compile error for the PdfDistiller: "User-defined type not defined". Do i need to install a third party PDF export plugin?
> 
> Thanks,


Welcome to the MrExcel board!

With over 250 posts in this thread, about 80 different posters, and the thread being 5 years old, it isn't easy to know which post(s) you are referring to or whether the particular member is still active in the forum. You would be well advised to point out which post(s) you are referring to.


----------



## imatjazz

Hi Peter, thank you for the note. 

I tired to run the script below to create pdf however I got a Runtime error 5. If I change the xlTypeXPS then it worked. I run this on my work laptop and not sure if there is issues with the xlTypePDF engine or my work laptop restriction.




		Code:
__


Sub SavePDF()
    Dim Path, FileName1 As String
    Path = "C:\temp\"  '<--- edit path as desired
    FileName1 = "TestPDF1"   '<--- change file name as desired
    ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & FileName1 & ".pdf", OpenAfterPublish:=False
End Sub


Thanks


----------



## ZVI

imatjazz said:


> Hi Michael,
> 
> I tried to run your code but got a compile error for the *PdfDistiller*: "User-defined type not defined". Do i need to install a third party PDF export plugin?
> 
> Thanks,


For me it's tiresome to read further the first page of this huge thread too 
Seems the question relates to the code of post #2 .
It is necessary to set reference via VBE-Tools-References to Acrobat Distiler


----------



## ZVI

imatjazz said:


> Hi Peter, thank you for the note.
> 
> I tired to run the script below to create pdf however I got a Runtime error 5. If I change the xlTypeXPS then it worked. I run this on my work laptop and not sure if there is issues with the xlTypePDF engine or my work laptop restriction.
> 
> 
> 
> 
> Code:
> __
> 
> 
> Sub SavePDF()
> Dim Path, FileName1 As String
> Path = "C:\temp\"  '<--- edit path as desired
> FileName1 = "TestPDF1"   '<--- change file name as desired
> ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & FileName1 & ".pdf", OpenAfterPublish:=False
> End Sub
> 
> 
> Thanks


 For early version of Excel 2007 you need to install "2007 Microsoft Office Add-in: Microsoft Save as PDF or XPS", the download link is in the post #35


----------



## shawn1983

Hi,

I was looking at this post and its something similar to what i need as well. can i check how do i assign this code to a button? In which event display event for outlook will occur when i press the button.


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## turkanet

Dear all,
first of all really thank you very much for this helpful thread.

Dear ZVI,
Everything is fine but even my default font for messages is Candara 11, mail comes with Calibri 10. how to change this?


----------



## turkanet

Also how can we prevent excel closing after running macro?


----------



## ZVI

turkanet said:


> ...Everything is fine but even my default font for messages is Candara 11, mail comes with Calibri 10. how to change this?


Hi,
Define font name and size of that font in the user settings section of the below code:


		Rich (BB code):
__


Sub Attach_Sheets_As_Pdf_With_Signature1()
' ZVI:2018-12-26 https://www.mrexcel.com/forum/excel-questions/710212-vba-code-convert-excel-pdf-email-attachment-post5197824.html#post5197824
 
  ' --> User settings, change to suit
  Const MySheets As Variant = "Sheet1;Sheet3" ' Use MySheets = "" for all sheets. Semicolon is used as list separator!
  Const IsDisplay As Boolean = True           ' Change to False for .Send instead of .Display
  Const IsSilent As Boolean = False           ' Change to True for Send without the confirmation MsgBox
  Const FontName = "Candara"                  ' Font name of the email body
  Const FontSize = 11                         ' Font size of the email body
  ' <-- End of settings
 
  Dim IsCreated As Boolean
  Dim OutlApp As Object
  Dim i As Long
  Dim char As Variant
  Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
 
  ' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
  HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")(/p)"
  HtmlFont = Replace(HtmlFont, "(", Chr(60))
  HtmlFont = Replace(HtmlFont, ")", Chr(62))
 
  ' Build HtmlBody for the email (Change to suit)
  HtmlBody = "Hi," & vbLf & vbLf _
           & "Please find the latest payroll report attached"
 
  ' Replace vbLf by its html tag
  HtmlBody = Replace(HtmlBody, vbLf, Chr(60) & "br" & Chr(62))
   
  ' Define PDF filename
  PdfFile = ActiveWorkbook.Name
  i = InStrRev(PdfFile, ".xl", , vbTextCompare)
  If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name
 
  ' Replace illegal symbols in PdfFile by underscore
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
 
  ' Apply %TEMP% path to the file name and limit lenght of the pathname
  PdfFile = Left(Environ("TEMP") & "\" & PdfFile, 251) & ".pdf"
  
  ' Try to delete PDF file if present
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Select sheets to be exported into the PDF (single) file
  If MySheets = "" Then
    ' All sheets to PDF
    Sheets.Select
  Else
    ' Only sheets listed in MySheets to PDF
    Sheets(Split(MySheets, ";")).Select
  End If
 
  ' Export the selected sheets as PDF to the temporary folder
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Select
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and the default signature
  With OutlApp.CreateItem(0)
   
    ' Set HTML format
    .BodyFormat = 2
      
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
  
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    HtmlSignature = .HtmlBody
   
    ' Insert sText into HtmlBody
    .Subject = "Payroll Report"
    .To = "someone@domain.com" ' Put 'To' email(s) here
    .CC = ""                   ' Carbon copy email(s)
    .HtmlBody = HtmlFont & HtmlBody & HtmlSignature
      
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
  
    ' Show error of the .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Show error/success message
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub


----------



## ZVI

turkanet said:


> Also how can we prevent excel closing after running macro?


The provided code does not quit Excel application, post your code to find the reason of the issue.


----------



## turkanet

Dear ZVI,
i apply below code. but i noticed that same file closes excel at my work , does not at my home. same operating systm + same office version. 
Second, i could not succeed to apply Candara even i tried to add some lines from your last advice. Need your kind comments. Thank you.



		Code:
__


Sub Send_PDF_customer()
' --> User settings, change to suit
Const IsHtml As Boolean = True     ' Change to True for HTML body of email
Const IsDisplay As Boolean = True  ' Change to True to .Display instead of .Send
Const IsSilent As Boolean = False  ' Change to True to Send without the confirmation MsgBox
Const FontName = "Candara"         ' Font name of the email body
Const FontSize = 11                ' Font size of the email body
' <-- End of settings
Dim IsCreated As Boolean
Dim MailSubject As String, PdfFile As String, s As String
Dim HtmlSignature As String, Signature As String
Dim OutlApp As Object
Dim i As Long
Dim char As Variant
' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")(/p)"
HtmlFont = Replace(HtmlFont, "(", Chr(60))
HtmlFont = Replace(HtmlFont, ")", Chr(62))
' Not sure for what the Title is
Title = Range("H2")
' Define PDF filename
PdfFile = ActiveSheet.Name
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Range("H2") & "_" & PdfFile & ".pdf"
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare email with PDF attachment and default signature
With OutlApp.CreateItem(0)
' Get default email signature without blinking (instead of .Display method)
With .GetInspector: End With
If IsHtml Then HtmlSignature = .HtmlBody Else Signature = .Body
' Prepare e-mail
.Display     '<-- This needs to be first for the signature to be added
.Subject = Range("H2") & " / " & Range("K1")
.To = Range("L1") ' <-- Put email of the recipient here
' Edit the body's text or html text as required
If IsHtml Then
' The tags are: h3 is for Header#3; b is for Bold; br is for line break
' HTML tag's brakets are not displayed properly in the forum post, thus replacing in s is used to fix this problem
s = "AAAAA, (br)" _
& "AAAAAA.(br)" _
& "AAAAA."
s = Replace(s, "(", "<")
s = Replace(s, ")", ">")
.HtmlBody = s & HtmlSignature
.Attachments.Add PdfFile
' Try to send
On Error Resume Next
.Display 'to send without displaying, change with .Send
Application.Visible = True
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End If
End With
End Sub


----------



## ZVI

turkanet said:


> ...I noticed that same file closes excel at my work , does not at my home. same operating system + same office version.
> Second, i could not succeed to apply Candara even i tried to add some lines from your last advice. Need your kind comments.


Below is the updating of your code.


		Rich (BB code):
__


Sub Send_PDF_customer1()
 
  ' --> User settings, change to suit
  Const IsDisplay As Boolean = True  ' Change to False for .Send instead of .Display
  Const IsSilent As Boolean = False  ' Change to True to show Send status
  Const FontName = "Candara"         ' Font name of the email body
  Const FontSize = 11                ' Font size of the email body
  ' <-- End of the settings
 
  Dim IsCreated As Boolean
  Dim OutlApp As Object
  Dim char As Variant
  Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
 
  ' Edit the body's html text as required
  ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
  ' HTML tag's are not displayed properly in the post of MrExcel forum, thus replacing is used to fix this problem
  HtmlBody = "First line, (br)" _
           & "Second line.(br)" _
           & "Third line."
  HtmlBody = Replace(HtmlBody, "(", "<")
  HtmlBody = Replace(HtmlBody, ")", ">")
 
  ' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
  HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")(/p)"
  HtmlFont = Replace(HtmlFont, "(", "<")
  HtmlFont = Replace(HtmlFont, ")", ">")
  
  ' Define PDF filename
  PdfFile = Range("H2") & "_" & ActiveSheet.Name
 
  ' Replace illegal symbols in PdfFile by underscore
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
 
  ' Apply %TEMP% path to the file name and limit lenght of the pathname
  PdfFile = Left(Environ("TEMP") & IIf(Right(Environ("TEMP"), 1) <> "\", "\", "") & PdfFile, 251) & ".pdf"
 
  ' Try to delete PDF file if present
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Export the activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and the default signature
  With OutlApp.CreateItem(0)
  
    ' Set HTML format
    .BodyFormat = 2
     
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
 
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    HtmlSignature = .HtmlBody
   
    ' Prepare e-mail
    .Subject = Range("H2") & " / " & Range("K1")
    .To = Range("L1")   ' <-- Put email of the recipient here
    .HtmlBody = HtmlFont & HtmlBody & HtmlSignature
           
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
 
    ' Show error of the .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Show error/success message
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub

Font of email sets correctly now.
On your work PC try to repair an Office application.
To find code line after which Excel quits put cursor into the code and hit F8 for step-by-step debugging till Excel quits.


----------



## ZVI

My bad, the typos in HtmlFont have been found. 
Please replace in the code of the post 263 and 266
this line: HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")(/p)"
by the: HtmlFont = "(body *style=""*font: " & FontSize & "pt " & FontName & ";color:black"")(/p)"


----------



## turkanet

This was so helpful, thank you very much.


----------



## ZVI

turkanet said:


> This was so helpful, thank you very much.


You are welcome, good luck!


----------



## turkanet

Dear ZVI,
how to change the code to send mail from specific mail account (not default one) and with its signature on outlook?
thank you


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

turkanet said:


> Dear ZVI,
> how to change the code to send mail from specific mail account (not default one) and with its signature on outlook?
> thank you


Hi, try using one of the solutions of Ron de Bruin shown in his web page Insert Outlook Signature in mail


----------



## ZVI

Or use the below code where the setting Const Account is an index or a name of the required account with its default signature.


		Rich (BB code):
__


Sub SendPDF_WithAccountSignatiure()
 
  ' --> User settings, change to suit
  Const IsDisplay As Boolean = True  ' Change to False for .Send instead of .Display
  Const IsSilent As Boolean = False  ' Change to True to show Send status
  Const FontName = "Candara"         ' Font name of the email body
  Const FontSize = 11                ' Font size of the email body
  Const *Account = 2*                  ' Index or Name of the account to send from
  ' <-- End of the settings
 
  Dim IsCreated As Boolean
  Dim OutlApp As Object
  Dim char As Variant
  Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
 
  ' Edit the body's html text as required
  ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
  ' HTML tag's are not displayed properly in the post of MrExcel forum, thus replacing is used to fix this problem
  HtmlBody = "First line, (br)" _
           & "Second line.(br)" _
           & "Third line."
  HtmlBody = Replace(HtmlBody, "(", "<")
  HtmlBody = Replace(HtmlBody, ")", ">")
 
  ' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
  HtmlFont = HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")"
  HtmlFont = Replace(HtmlFont, "(", "<")
  HtmlFont = Replace(HtmlFont, ")", ">")
 
  ' Define PDF filename
  PdfFile = Range("H2") & "_" & ActiveSheet.Name
 
  ' Replace illegal symbols in PdfFile by underscore
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
 
  ' Apply %TEMP% path to the file name and limit lenght of the pathname
  PdfFile = Left(Environ("TEMP") & IIf(Right(Environ("TEMP"), 1) <> "\", "\", "") & PdfFile, 251) & ".pdf"
 
  ' Try to delete PDF file if present
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Export the activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use the already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare email with PDF attachment and the default signature
  With OutlApp.CreateItem(0)
 
    ' Set HTML format
    .BodyFormat = 2
    
    ' Add the attachment first for correct attachment's name with non English symbols
    .Attachments.Add PdfFile
 
    ' Set the required account by const Account
    Set .SendUsingAccount = OutlApp.Session.Accounts.Item(*Account*)
   
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    HtmlSignature = .HtmlBody
  
    ' Prepare e-mail
    .Subject = Range("H2") & " / " & Range("K1")
    .To = Range("L1")   ' <-- Put email of the recipient here
    .HtmlBody = HtmlFont & HtmlBody & HtmlSignature
          
    ' Try to send or just display the e-mail
    On Error Resume Next
    If IsDisplay Then .Display Else .Send
 
    ' Show error of the .Send method
    If Not IsDisplay Then
      ' Return focus to Excel's window
      Application.Visible = True
      ' Show error/success message
      If Err Then
        MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
        .Display
      Else
        If Not IsSilent Then
          MsgBox "E-mail successfully sent", vbInformation
        End If
      End If
    End If
    On Error GoTo 0
 
  End With
 
  ' Delete the temporary PDF file
  If Len(Dir(PdfFile)) Then Kill PdfFile
 
  ' Try to quit Outlook if it was not previously open
  If IsCreated Then OutlApp.Quit
 
  ' Try to release the memory of object variable
  Set OutlApp = Nothing
 
End Sub

Regards


----------



## WERNER SLABBERT

I have been trying( to no avail) to apply these steps to my Macro... but hell it gets confusing...  can i kinda aslo maybe ask some help... ? the PDF save section works great, its the sending the attchment from specific account with my signature bit that has me baffled completely...


		Code:
__


Sub SaveIt()  
    On Error Resume Next 'In case it already exists
MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Famous_Brands" & "\" & Range("C7").Value
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False


    Dim Filename As String
    Dim Path As String
    Dim i As Integer
    Dim Mail_Object
    Dim Email_Subject
    Dim o As Variant
    
    Filename = Format(Date, "yyyy_mm_dd") & "_" & Range("J7").Value & "_" & Range("J8").Value
    Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Path & "\Famous_Brands" & "\" & Range("C7").Value & "\" & Filename & ".Pdf", _
            Quality:=xlQualityStandard, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True


    ActiveWorkbook.SaveAs Filename:=Path & "\Famous_Brands" & "\" & "Complete_Job_Card_2018", _
                            FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                            Password:="", _
                            WriteResPassword:="", _
                            ReadOnlyRecommended:=False, _
                            CreateBackup:=False
                                                      
        ActiveWorkbook.SaveAs Filename:=Path & "\" & "Complete_Job_Card_2018", _
                            FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                            Password:="", _
                            WriteResPassword:="", _
                            ReadOnlyRecommended:=False, _
                            CreateBackup:=False
                                        
            Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)
            .Subject = "Famous Brands Repair Job Card" ' CHANGE TO SUIT
            .To = "receptionpta@nexusgroup.co.za" 'CHANGE TO SUIT
            .Body = "Machine Repaired and Ready for collection or courier." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "Werner Johan Slabbert" & Chr(13) & "Nexus Technical" 'Change comments to suit
            .Attachments.Add Filename
            .Send
    End With
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing


 
End Sub




ZVI said:


> Or use the below code where the setting Const Account is an index or a name of the required account with its default signature.
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub SendPDF_WithAccountSignatiure()
> 
> ' --> User settings, change to suit
> Const IsDisplay As Boolean = True  ' Change to False for .Send instead of .Display
> Const IsSilent As Boolean = False  ' Change to True to show Send status
> Const FontName = "Candara"         ' Font name of the email body
> Const FontSize = 11                ' Font size of the email body
> Const *Account = 2*                  ' Index or Name of the account to send from
> ' <-- End of the settings
> 
> Dim IsCreated As Boolean
> Dim OutlApp As Object
> Dim char As Variant
> Dim PdfFile As String, HtmlFont As String, HtmlBody As String, HtmlSignature As String
> 
> ' Edit the body's html text as required
> ' The tags are: h3 is for Header#3; b is for Bold; br is for line break
> ' HTML tag's are not displayed properly in the post of MrExcel forum, thus replacing is used to fix this problem
> HtmlBody = "First line, (br)" _
> & "Second line.(br)" _
> & "Third line."
> HtmlBody = Replace(HtmlBody, "(", "<")
> HtmlBody = Replace(HtmlBody, ")", ">")
> 
> ' Set the font for the html-body (parentheses are just because of MrExcel posting limitation)
> HtmlFont = HtmlFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")"
> HtmlFont = Replace(HtmlFont, "(", "<")
> HtmlFont = Replace(HtmlFont, ")", ">")
> 
> ' Define PDF filename
> PdfFile = Range("H2") & "_" & ActiveSheet.Name
> 
> ' Replace illegal symbols in PdfFile by underscore
> For Each char In Split("? "" / \ < > * | :")
> PdfFile = Replace(PdfFile, char, "_")
> Next
> 
> ' Apply %TEMP% path to the file name and limit lenght of the pathname
> PdfFile = Left(Environ("TEMP") & IIf(Right(Environ("TEMP"), 1) <> "\", "\", "") & PdfFile, 251) & ".pdf"
> 
> ' Try to delete PDF file if present
> If Len(Dir(PdfFile)) Then Kill PdfFile
> 
> ' Export the activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use the already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare email with PDF attachment and the default signature
> With OutlApp.CreateItem(0)
> 
> ' Set HTML format
> .BodyFormat = 2
> 
> ' Add the attachment first for correct attachment's name with non English symbols
> .Attachments.Add PdfFile
> 
> ' Set the required account by const Account
> Set .SendUsingAccount = OutlApp.Session.Accounts.Item(*Account*)
> 
> ' Get default email signature without blinking (instead of .Display method)
> With .GetInspector: End With
> HtmlSignature = .HtmlBody
> 
> ' Prepare e-mail
> .Subject = Range("H2") & " / " & Range("K1")
> .To = Range("L1")   ' <-- Put email of the recipient here
> .HtmlBody = HtmlFont & HtmlBody & HtmlSignature
> 
> ' Try to send or just display the e-mail
> On Error Resume Next
> If IsDisplay Then .Display Else .Send
> 
> ' Show error of the .Send method
> If Not IsDisplay Then
> ' Return focus to Excel's window
> Application.Visible = True
> ' Show error/success message
> If Err Then
> MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
> .Display
> Else
> If Not IsSilent Then
> MsgBox "E-mail successfully sent", vbInformation
> End If
> End If
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete the temporary PDF file
> If Len(Dir(PdfFile)) Then Kill PdfFile
> 
> ' Try to quit Outlook if it was not previously open
> If IsCreated Then OutlApp.Quit
> 
> ' Try to release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub
> 
> Regards


----------



## WERNER SLABBERT

i also would like to implement this in my current macro but Veni,Vidi Velcro... it realy isn't as easy as my noob brain would make it out to be... here is my current macro (pieced together and all.. i would like to attach the saved file to the email with a specific account sending it and a specific signature called "Nexus" 

Please help all you smart people...



		Code:
__


Sub SaveIt()  
    On Error Resume Next 'In case it already exists
MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Famous_Brands" & "\" & Range("C7").Value
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False


    Dim Filename As String
    Dim Path As String
    Dim i As Integer
    Dim Mail_Object
    Dim Email_Subject
    Dim o As Variant
    
    Filename = Format(Date, "yyyy_mm_dd") & "_" & Range("J7").Value & "_" & Range("J8").Value
    Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Path & "\Famous_Brands" & "\" & Range("C7").Value & "\" & Filename & ".Pdf", _
            Quality:=xlQualityStandard, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True


    ActiveWorkbook.SaveAs Filename:=Path & "\Famous_Brands" & "\" & "Complete_Job_Card_2018", _
                            FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                            Password:="", _
                            WriteResPassword:="", _
                            ReadOnlyRecommended:=False, _
                            CreateBackup:=False
                                                      
        ActiveWorkbook.SaveAs Filename:=Path & "\" & "Complete_Job_Card_2018", _
                            FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                            Password:="", _
                            WriteResPassword:="", _
                            ReadOnlyRecommended:=False, _
                            CreateBackup:=False
                                        
            Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)
            .Subject = "Famous Brands Repair Job Card" ' CHANGE TO SUIT
            .To = "receptionpta@nexusgroup.co.za" 'CHANGE TO SUIT
            .Body = "Machine Repaired and Ready for collection or courier." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "Werner Johan Slabbert" & Chr(13) & "Nexus Technical" 'Change comments to suit
            .Attachments.Add Filename
            .Send
    End With
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing


 
End Sub


----------



## Horspool68

Hi there I've pasted your recommended code as below  however when I try to run it I get 
" Compile error: 
User-defined type not defined "
at the same time  "mypdfDist As New PdfDistiller" is highlighted.
Any help please ?




		Code:
__


Private Sub CommandButton1_Click()
Dim tempPDFFileName, tempPSFileName, tempPDFRawFileName As String, mypdfDist As New PdfDistiller, _
 i As Integer, Mail_Object, Email_Subject, o As Variant
    tempPDFRawFileName = [COLOR=#FF0000]"V:\Manufacturing\Forms\Handover\Auto Handover Archive\DO NOT DELETE" & Range("CL2") [/COLOR]' Change File Path to suit
    tempPSFileName = tempPDFRawFileName & ".ps"
    tempPDFFileName = tempPDFRawFileName & ".pdf"
    ActiveSheet.PrintOut Copies:=1, preview:=False, ActivePrinter:="Adobe PDF", _
        printtofile:=True, Collate:=True, prtofilename:=tempPSFileName
    mypdfDist.FileToPDF tempPSFileName, tempPDFFileName, ""
     Kill tempPSFileName
Set mypdfDist = Nothing


'************End of PDF section*************
'************Start of emailing code*********
    Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)
            .Subject = Range("CL2") ' CHANGE TO SUIT
            .To = "mark.horspool@radius-systems.com" 'CHANGE TO SUIT
            .Body = "E MAIL TEXT GOES HERE" & Chr(13) & Chr(13) & "Regards," & Chr(13) & "YOUR NAME." & Chr(13) & "YOUR ADDRESS." 'Change comments to suit
            .Attachments.Add tempPDFFileName
            .Send
    End With
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing


End Sub


----------



## vbacoder1962

Where can one get the [PDFDistiller] object referred to in the code above? Kindly send the link by reply and oblige.


----------



## ddhuggi

WERNER SLABBERT said:


> i also would like to implement this in my current macro but Veni,Vidi Velcro... it realy isn't as easy as my noob brain would make it out to be... here is my current macro (pieced together and all.. i would like to attach the saved file to the email with a specific account sending it and a specific signature called "Nexus"
> 
> Please help all you smart people...
> 
> 
> 
> Code:
> __
> 
> 
> Sub SaveIt()
> On Error Resume Next 'In case it already exists
> MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Famous_Brands" & "\" & Range("C7").Value
> 
> ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
> 
> 
> Dim Filename As String
> Dim Path As String
> Dim i As Integer
> Dim Mail_Object
> Dim Email_Subject
> Dim o As Variant
> 
> Filename = Format(Date, "yyyy_mm_dd") & "_" & Range("J7").Value & "_" & Range("J8").Value
> Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
> 
> ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
> Filename:=Path & "\Famous_Brands" & "\" & Range("C7").Value & "\" & Filename & ".Pdf", _
> Quality:=xlQualityStandard, _
> IgnorePrintAreas:=False, _
> OpenAfterPublish:=True
> 
> 
> ActiveWorkbook.SaveAs Filename:=Path & "\Famous_Brands" & "\" & "Complete_Job_Card_2018", _
> FileFormat:=xlOpenXMLTemplateMacroEnabled, _
> Password:="", _
> WriteResPassword:="", _
> ReadOnlyRecommended:=False, _
> CreateBackup:=False
> 
> ActiveWorkbook.SaveAs Filename:=Path & "\" & "Complete_Job_Card_2018", _
> FileFormat:=xlOpenXMLTemplateMacroEnabled, _
> Password:="", _
> WriteResPassword:="", _
> ReadOnlyRecommended:=False, _
> CreateBackup:=False
> 
> Set Mail_Object = CreateObject("Outlook.Application")
> With Mail_Object.CreateItem(o)
> .Subject = "Famous Brands Repair Job Card" ' CHANGE TO SUIT
> .To = "receptionpta@nexusgroup.co.za" 'CHANGE TO SUIT
> .Body = "Machine Repaired and Ready for collection or courier." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "Werner Johan Slabbert" & Chr(13) & "Nexus Technical" 'Change comments to suit
> .Attachments.Add Filename
> .Send
> End With
> MsgBox "E-mail successfully sent", 64
> Application.DisplayAlerts = False
> Set Mail_Object = Nothing
> 
> 
> 
> End Sub



Need help on corrections in this coding. I am receiving the PDF file in 4 pieces. I need it to be sent in one form. IS there a way to adjust the code to take all 4 pages and condense it to 1 page?


----------



## Padthelad

ZVI said:


> To use signature with formatted text  & picture, the .HTMLBody should be used in the code instead of the just .Body
> Code in post #159 reflects both methods: using of HTML signature with HTML formatted message, and the plain text message with text of a signature.
> Here is a mixed version of the code where plain text of the message is converted to a simple HTML code with full HTML signature
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub Attach_Sheets_As_Pdf_With_HTMLSignature()
> ' ZVI:2016-09-21 http://www.mrexcel.com/forum/excel-questions/710212-visual-basic-applications-code-convert-excel-pdf-email-attachment-post4637844.html#post4637844
> 
> ' --> User settings, change to suit
> Const MySheets As Variant = "Sheet1,Sheet3" ' Use MySheets = 0 for all the sheets
> Const IsDisplay As Boolean = True           ' Change to False to .Send instead of .Display
> Const IsSilent As Boolean = False           ' Change to True to Send without the confirmation MsgBox
> ' <-- End of settings
> 
> Dim IsCreated As Boolean
> Dim PdfFile As String, Signature As String, Message As String
> Dim OutlApp As Object
> Dim i As Long
> Dim char As Variant
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.Name
> i = InStrRev(PdfFile, ".xl", , vbTextCompare)
> If i > Len(PdfFile) - 5 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name
> ' Clean up the name of PDF file
> For Each char In Split("? "" / \ < > * | :")
> PdfFile = Replace(PdfFile, char, "_")
> Next
> ' Add %TEMP% path to the file name and limit too long name
> PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
> 
> ' Try to delete PDF file for the case it was not deleted at debugging
> If Len(Dir(PdfFile)) Then Kill PdfFile
> 
> ' Select sheets to be exported in the PDF (single) file
> If MySheets = 0 Then
> ' All sheets to PDF
> Sheets.Select
> Else
> ' Sheets listed in MySheets to PDF
> Sheets(Split(MySheets, ",")).Select
> End If
> 
> ' Export the selected sheets as PDF to the temporary folder
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> .Select
> End With
> 
> ' Use the already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> On Error GoTo 0
> 
> ' Prepare email with PDF attachment and default signature
> With OutlApp.CreateItem(0)
> 
> ' Add the attachment first for correct attachment's name with non English symbols
> .Attachments.Add PdfFile
> 
> ' Get default email signature without blinking (instead of .Display method)
> With .GetInspector: End With
> Signature = .HTMLBody
> 
> ' Prepare e-mail (uncommenmt and fill the lines below)
> .Subject = "Payroll Monthly Analysis"
> .To = Range("L3").Value
> .CC = Range("L4").Value
> Message = "Hi," & vbLf & vbLf _
> & "Please find the latest payroll report attached"
> 
> .HTMLBody = Replace(Message, vbLf, Chr(60) & "br" & Chr(62)) & Signature
> 
> ' Try to send or just display the e-mail
> On Error Resume Next
> If IsDisplay Then .Display Else .Send
> 
> ' Show error of .Send method
> If Not IsDisplay Then
> ' Return focus to Excel's window
> Application.Visible = True
> ' Report on error or success
> If Err Then
> MsgBox "E-mail was not sent for some reasons" & vbLf & "Please check it", vbExclamation
> .Display
> Else
> If Not IsSilent Then
> MsgBox "E-mail successfully sent", vbInformation
> End If
> End If
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete the temporary PDF file
> If Len(Dir(PdfFile)) Then Kill PdfFile
> 
> ' Try to quit Outlook if it was not previously open
> If IsCreated Then OutlApp.Quit
> 
> ' Try to release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub



Hi ZVI,

Thank you for your continued help with this project. It seems that many people have benefitted from your skills.

I am using the above code but need to adapt it to attach the sheets as Excel worksheets instead of PDF. Also, It would be great if I could list all the sheets to attach in column A on 'My Sheets' (to be renamed 'Email Sheets' to be attached to an individual email. As in each sheet will be separately emailed to an address in a cell on that sheet. Finally, I have two inboxes on my Outlook, is it possible to define which email address to send it from?

I would appreciate your help with this, as I am unable to find the solutions myself.

Many thanks in advance.

Pad


----------



## JRocket1207

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


I have used your code and it worked great.  The only thing is that I wanted to add that I want it to print a select range and in landscape format and one page wide and one page tall.  I tried to add the following code and it would not work: 

  ' Export activesheet as PDF
  With ActiveSheet
.PageSetup.Orientation = xLandscape
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = "$A$1:$L$31"
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

I also tried With Sheets("Sheet1")
.PageSetup.Orientation = xLandscape
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = "$A$1:$L$31"
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

Using With Sheets("Sheet1") worked until I added the .PageSetup items.  Can you help at all?


----------



## fahim159

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub





ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub





ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


Code is awesome and working for me. But I need help little more help. Email address will vary. So I want the code that take email address from cell C14.
And if possible then the pdf range should be A1:K55


----------



## aarondesin91

Dear Forumers,

I really need your help. I am new to this whole VBA coding thing have no basic at all in programming and stuff so please help me out here. I am currently assigned a project where I have to create a excel sheet which act as a templete for sending request. The requirement of the project is that I need a vba code for a button when i click it, it will convert my active sheet alone to pdf, automatically save it with the title captured from a cell in the active sheet which is entered by the user. Email this pdf as a attachment to the specific person. Please help me out, my job depends on this project please guys out there.

Thank you


----------



## ZVI

Hi Fahim, welcome to the MrExcel Board!

See the below changes in *Red*:


		Rich (BB code):
__


  ' Export activesheet as PDF
  With ActiveSheet
*    .PageSetup.PrintArea = "$A$1:$K$55"*
*    .PageSetup.FitToPagesWide = 1*
*    .PageSetup.FitToPagesTall = 1*
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

'...
    ' Prepare e-mail
    .Subject = Title
    *.To = Range("C14").Value*


----------



## fahim159

ZVI said:


> Hi Fahim, welcome to the MrExcel Board!
> 
> See the below changes in *Red*:
> 
> 
> Rich (BB code):
> __
> 
> 
> ' Export activesheet as PDF
> With ActiveSheet
> *    .PageSetup.PrintArea = "$A$1:$K$55"*
> *    .PageSetup.FitToPagesWide = 1*
> *    .PageSetup.FitToPagesTall = 1*
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> '...
> ' Prepare e-mail
> .Subject = Title
> *.To = Range("C14").Value*


You are awesome. Thank you. How can I use default html signature in outlook?


----------



## ZVI

fahim159 said:


> Thank you. How can I use default html signature in outlook?


You are welcome.
Solutions with default signature have been posted on the previous two pages.
See for example the code of #272
Just change value of the constant Account to 1, like this:
Const Account = *1*


----------



## luckyearl

Dear ZVI, have been using your code from 2017, working well. At home, got myself a mac, now the worksheet wud only open in read only mode (ActiveX !). wondering if you can suggest a solution which wud work equally well in mac & windows with similar functionality
cheers


----------



## ZVI

luckyearl said:


> Dear ZVI, have been using your code from 2017, working well. At home, got myself a mac, now the worksheet wud only open in read only mode (ActiveX !). wondering if you can suggest a solution which wud work equally well in mac & windows with similar functionality
> cheers


Hi,
Unfortunately, I never used a MAC.
VBA in MAC is limitted and not 100% compatible with VBA in Windows OS.
Here is the link to Ron de Bruin samples for MAC, hope you'll find the solutions - Mail from Excel and make/mail PDF files (Mac)


----------



## Faten

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


Hi Guys,

I have used this above code to convert my excel sheet to
PDF and send attachment email automatically. it worked perfectly  but there is still one problem this code send email with the pdf attachment  before excel finish its calculation .So what I need is send the PDF format after the excel finish all calculation and ready. Any help?


----------



## jasonmarden

ZVI said:


> The template code for Excel 2007+ with its own PDF converter:
> 
> 
> Rich (BB code):
> __
> 
> 
> Sub AttachActiveSheetPDF()
> Dim IsCreated As Boolean
> Dim i As Long
> Dim PdfFile As String, Title As String
> Dim OutlApp As Object
> 
> ' Not sure for what the Title is
> Title = Range("A1")
> 
> ' Define PDF filename
> PdfFile = ActiveWorkbook.FullName
> i = InStrRev(PdfFile, ".")
> If i > 1 Then PdfFile = Left(PdfFile, i - 1)
> PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
> 
> ' Export activesheet as PDF
> With ActiveSheet
> .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
> End With
> 
> ' Use already open Outlook if possible
> On Error Resume Next
> Set OutlApp = GetObject(, "Outlook.Application")
> If Err Then
> Set OutlApp = CreateObject("Outlook.Application")
> IsCreated = True
> End If
> OutlApp.Visible = True
> On Error GoTo 0
> 
> ' Prepare e-mail with PDF attachment
> With OutlApp.CreateItem(0)
> 
> ' Prepare e-mail
> .Subject = Title
> .To = "..." ' <-- Put email of the recipient here
> .CC = "..." ' <-- Put email of 'copy to' recipient here
> .Body = "Hi," & vbLf & vbLf _
> & "The report is attached in PDF format." & vbLf & vbLf _
> & "Regards," & vbLf _
> & Application.UserName & vbLf & vbLf
> .Attachments.Add PdfFile
> 
> ' Try to send
> On Error Resume Next
> .Send
> Application.Visible = True
> If Err Then
> MsgBox "E-mail was not sent", vbExclamation
> Else
> MsgBox "E-mail successfully sent", vbInformation
> End If
> On Error GoTo 0
> 
> End With
> 
> ' Delete PDF file
> Kill PdfFile
> 
> ' Quit Outlook if it was created by this code
> If IsCreated Then OutlApp.Quit
> 
> ' Release the memory of object variable
> Set OutlApp = Nothing
> 
> End Sub


Using MS Office 365 and I wondered whether this code would work for me?  Ive no VBA or Macro writing experience but trying to learn as I go.  Do I need to delete the green text I.E. 'Delete PDF file?

Many thanks in advance.

Jason


----------



## MilkyTech

jasonmarden said:


> Using MS Office 365 and I wondered whether this code would work for me?  Ive no VBA or Macro writing experience but trying to learn as I go.  Do I need to delete the green text I.E. 'Delete PDF file?
> 
> Many thanks in advance.
> 
> Jason


No need to delete the comments (green text).
See this stack thread regarding 365:








						Office 365 versus desktop Excel macros
					

Sorry if the title is very vague, I've been trying to work my way around this for a little while now, but I have to say that I know very little about Office 365 and its abouts.  I've developed a se...




					stackoverflow.com


----------

