email with pdf

werevollf

New Member
Joined
Sep 5, 2017
Messages
8
Hello everyone, I have spread sheet for like handover and each day needs to be send out
Is it possible instead of FileExtStr = ".xlsm" get .pdf somehow?
This is code I am using at the moment to create email

Code:
Sub EmailWorkbook()
'PURPOSE: Create email message with ActiveWorkbook attachedDim SourceWB As Workbook
Dim DestinWB As Workbook
Dim OutlookApp As Object
Dim OutlookMessage As Object
Dim TempFileName As Variant
Dim ExternalLinks As Variant
Dim TempFilePath As String
Dim FileExtStr As String
Dim DefaultName As String
Dim UserAnswer As Long
Dim x As Long
Set SourceWB = ActiveWorkbook
'Check for macro code residing in
  If Val(Application.Version) >= 12 Then
    If SourceWB.FileFormat = 51 And SourceWB.HasVBProject = True Then
      UserAnswer = MsgBox("There was VBA code found in this xlsx file. " & _
        "If you proceed the VBA code will not be included in your email attachment. " & _
        "Do you wish to proceed?", vbYesNo, "VBA Code Found!")
     
    If UserAnswer = vbNo Then Exit Sub 'Handle if user cancels
  
    End If
  End If
'Determine Temporary File Path
  TempFilePath = Environ$("temp") & "\"
'Determine Default File Name for InputBox
  If SourceWB.Saved Then
    DefaultName = Left(SourceWB.Name, InStrRev(SourceWB.Name, ".") - 1)
  Else
    DefaultName = SourceWB.Name
  End If
'Ask user for a file name
  TempFileName = ActiveSheet.Range("A1").Text & Chr(32) & ActiveSheet.Range("A2").Text
  
'Determine File Extension
  If SourceWB.Saved = True Then
    FileExtStr = "." & LCase(Right(SourceWB.Name, Len(SourceWB.Name) - InStrRev(SourceWB.Name, ".", , 1)))
  Else
  
    FileExtStr = ".xlsm"
  End If
'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.DisplayAlerts = False
'Save Temporary Workbook
  SourceWB.SaveCopyAs TempFilePath & TempFileName & FileExtStr
  Set DestinWB = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
'Break External Links
  ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)
    'Loop Through each External Link in ActiveWorkbook and Break it
      On Error Resume Next
        For x = 1 To UBound(ExternalLinks)
          DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
        Next x
      On Error GoTo 0
      
'Save Changes
  DestinWB.Save
'Create Instance of Outlook
  On Error Resume Next
    Set OutlookApp = GetObject(Class:="Outlook.Application") 'Handles if Outlook is already open
  Err.Clear
    If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(Class:="Outlook.Application") 'If not, open Outlook
    
    If Err.Number = 429 Then
      MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
      GoTo ExitSub
    End If
  On Error GoTo 0
'Create a new email message
  Set OutlookMessage = OutlookApp.CreateItem(0)
'Create Outlook email with attachment
  On Error Resume Next
    With OutlookMessage
     .To = "[EMAIL="Test@email.com"]Test@email.com[/EMAIL]"
     .CC = ""
     .BCC = ""
     .Subject = "Handover" & Chr(32) & ActiveSheet.Range("A1").Text & Chr(32) & Format(Now, "dd-mm-yyyy")
     .Body = "Please see attached." & vbNewLine & vbNewLine & "Boris"
     .Attachments.Add DestinWB.FullName
     .Display
    End With
  On Error GoTo 0
'Close & Delete the temporary file
  DestinWB.Close SaveChanges:=False
  Kill TempFilePath & TempFileName & FileExtStr
'Clear Memory
  Set OutlookMessage = Nothing
  Set OutlookApp = Nothing
  
'Optimize Code
ExitSub:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.DisplayAlerts = True
End Sub



Thanks!
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
What I do is to export my sheets as a pdf and then e-mail the pdf. You could then delete the pdf

Code:
Worksheets(Array("Performance Graphs", "Items", "Debits", "Supp_Scars")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fname, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
 
Upvote 0
I appreciate the help, but I still need how to send email with pdf. Thing is I`m not only one who is using it and I`m trying to simplify as much as possible for others as there knowledge with spread sheets are very limited.
 
Upvote 0

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,093
Latest member
dbomb1414

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
Back
Top