Customising a GREAT bit of coding

[DensonM]

HI all,

I found this bit of coding on here, so if the person that wrote it see this then I am very impressed. However I wanted some advice on how to customise it. I have attached the coding below.

• I was wanting to be able to specify the sheets it creates as a PDF, the result being that there maybe three pages created in a PDF from a workbook book with 5 sheets.
• I wanted to add another e-mail address to the CC field

If there is someone clever enough to be able to help I would be forever grateful.

Private Sub CommandButton1_Click()
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 = "mainemail@mail.co.uk"
    .CC = "otheremail@mail.co.uk" (Bit of coding to add another email address)

    .Body = "Hi all," & vbLf & vbLf _
          & "Here is a deal we are looking at, PDF attached" & vbLf & vbLf _
          & "Regards,Chris & John" & 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

 

[Michael M]

In answer to the 2nd question
Try this

.CC = "otheremail@mail.co.uk"& ";" & "yetanotheremail@mail.co.uk"

With the first question, you want to create the 3 sheets seperately, or as a block ???

 

[DensonM]

Hi Michael,

Thank you for replying it is really appreciated. I was wanting to combine three separate sheets in to on PDF that would contain the three pages I want, whilst leaving the rest. Hope that makes sense.

Marc

 

[Michael M]

Are the names of the 3 sheets constant ??
If so, what are their names ?

 

[Michael M]

don't have EXcel at the moment, so this is [colorred] UNTESTED[/color]
Replace this part

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

with

  ' Export activesheet as PDF
  Sheets(Array("1stSheetName", "2ndSheetName", "3rdSheetName")).Select 'change sheetnames to suit
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\TEMP\" & PdfFile & ".pdf" 'change path name to suit

 

[DensonM]

Michael the sheets are always the same name. I have protected the sheet and it would be used without changing the names of the sheets.

The sheet names are:
Refurbishment costings
Deal analysis
Summary

Thanks again for replying to this. I had not sent me an e-mail so I was not aware you had replied. So my apologies if it appeared rude of me. I appreciate you time and effort on this.

 

[DensonM]

Michael the sheets are always the same name. I have protected the sheet and it would be used without changing the names of the sheets.

The sheet names are:
Refurbishment costings
Deal analysis
Summary

Thanks again for replying to this. I had not sent me an e-mail so I was not aware you had replied. So my apologies if it appeared rude of me. I appreciate you time and effort on this.

I have changed it to the following;
' Export activesheet as PDF
Sheets(Array("Refurbishment costings", "Deal analysis", "Summary")).Select 'change sheetnames to suit (DO I NEED THIS BIT IN THE CODING?)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\TEMP\" & PdfFile & ".pdf" 'change path name to suit

 

[DensonM]

Hi Michael,

It throws up an error saying "System Error &H8007007B (-2147024773)" I have reverted it back to how it was for now. I hop eyou are able to share your wisdom again.

Your Gratefully
Marc

 

[DensonM]

Since posting these I was messing around following the error and combined both codes..

' Export activesheet as PDF
Sheets(Array("Refurbishment costings", "Deal analysis", "Summary")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

This successfully did what I needed to. SO thank you for your help.