Issue when creating pdfs with part of name linked to cell

CDA2021

New Member
Joined
Apr 29, 2021
Messages
4
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I am using some code that I have modified and added to form various threads on here- especially the very long one about emailing individual tabs as pdfs to specific individuals (which is basically what I want it to do). I have got most of it to do what I want but my current issue is that I want the pdf filename to start with a date referenced from a cell on the activesheet.
My current code names the file based on the filename then the bit I want then some text then the tab name. This also saves the pdfs produced in the same folder as the spreadsheet.
Extract below:

Rich (BB code):
' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & Format(ActiveSheet.Range("E2").Value, "mmm yy") & " Monthly P&L " & ActiveSheet.Name & ".pdf"
 
'PdfFile = Format(ActiveSheet.Range("E2").Value, "mmm yy") & PdfFile & " Monthly P&L " & ActiveSheet.Name & ".pdf"
   
    ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

I thought that I could achieve what I wanted by putting the red line in place of the one above, as this simply rearranges the order of the existing items, but that didnt work.
I can modify the line and make it simpler but then I had to remove the PdfFile = ActiveWorkbook.FullName line as well and it works but no longer saves the pdf file as well as generating the email?

First time noob poster so sorry I have not explained or pasted that very well....
Cheers
 
Last edited by a moderator:

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

CDA2021

New Member
Joined
Apr 29, 2021
Messages
4
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Oops, actually what then happens is it creates and saves the file with the correct name but then doesn't attach it to the email it opens?
I will paste the entire messy code below, which as I said is cribbed from bits on this forum and has various redundant bits still in (and some things (Outlook default signature) that are not working yet..


VBA Code:
Option Explicit

Sub SendPDFToAddresses()
    'Assumes one email address in each cell in column A starting with row 2
    'Assumes the worksheet to be sent to the that address is in column B starting with row 2
    
          'OUTLOOK WARNING: If the email address is not correct then Outlook will use your email address book
    '  and use the closest to the incorrect address
    
    'Extension note:
    'The email body and subject are hard coded.  If you want to have a different subject/body
    '  for each email, add additional columns to Sheet1 and extend the code to extract those values
    
    Dim lRowIndex As Long
    Dim sAddress As String
    Dim sWorksheet As String
    Dim lLastRow As Long
    Dim OutlApp As Object
    Dim OutMail As Object
    
    ThisWorkbook.Activate
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
     
    With Worksheets("Sheet1")
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lRowIndex = 2 To lLastRow
            sAddress = .Cells(lRowIndex, 1).Value
            sWorksheet = .Cells(lRowIndex, 2).Value
            Worksheets(sWorksheet).Select
            Mail_PDFActiveSheet sAddress
        Next
    End With
    
        
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    
End Sub

Sub Mail_PDFActiveSheet(sAddress As String)
    'Adapted from http://www.rondebruin.nl/win/s1/outlook/mail.htm
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutMail As Object
    Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String, HtmlFont As String, HtmlBody As String, HtmlSignature 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 & Format(ActiveSheet.Range("E2").Value, "mmm yy") & " Monthly P&L " & ActiveSheet.Name & ".pdf"
  
 'PdfFile = Format(ActiveSheet.Range("E2").Value, "mmm yy") & PdfFile & " Monthly P&L " & 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
          
    Set OutMail = OutlApp.CreateItem(0)
           On Error Resume Next
        With OutMail
            .Display
            ' Set HTML format
             .BodyFormat = 2
            .To = sAddress
            .CC = ""
            .BCC = ""
            .Subject = Format(ActiveSheet.Range("E2").Value, "d mmm yy") & " Monthly P&L"
            .Body = "Attached is the " & ActiveSheet.Range("D7").Value & " for " & ActiveSheet.Range("D6").Value
            .Attachments.Add PdfFile
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            'With .GetInspector: End With
             'HtmlSignature = .HtmlBody
             
            'Uncomment one or the other of the following 2 lines
            '.Display    'to show and require manual send for each email
            '.Send       'to send each email immediately
            
        End With
        On Error GoTo 0
        '.Close savechanges:=False
    'End With
    
      Set OutMail = Nothing
    
End Sub
 

CDA2021

New Member
Joined
Apr 29, 2021
Messages
4
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Well, changing the code below means it names the pdf correctly and attaches it to the email but then doesn't save it in the folder? I cannot see anything wrong with the filename - no illegal characters
VBA Code:
 ' Define PDF filename
  'PdfFile = ActiveWorkbook.FullName
  'i = InStrRev(PdfFile, ".")
 ' If i > 1 Then PdfFile = Left(PdfFile, i - 1)
 ' PdfFile = PdfFile & Format(ActiveSheet.Range("E2").Value, "mmm yy") & " Monthly P&L " & ActiveSheet.Name & ".pdf"
  PdfFile = Format(ActiveSheet.Range("E2").Value, "mmm yy") & " Monthly P&L " & ActiveSheet.Name & ".pdf"

I am not sure where the file is being saved in the original code or not being saved with the changes?
 

CDA2021

New Member
Joined
Apr 29, 2021
Messages
4
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Well I have sort of solved my own problem by including thisworkbook.path as below
VBA Code:
   ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "/" & PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
Solution

Forum statistics

Threads
1,141,858
Messages
5,709,039
Members
421,608
Latest member
jking1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top