VBA Bug: Sending Sheet as PDF via outlook.

[countryfan_nt]

Hello friends, hope all is well!
Please help having a bug, I am trying to send a sheet as a pdf via vba.

The bug occurs on line: .Attachments.Add mypath & "\" & PdfFile & ".pdf"

I think the problem is with the path, but I don't know what and how to edit it

thank you so much in advance!

Sub EMAIL()

Set OutApp = GetObject(, "Outlook.Application")
Dim IsCreated As Boolean
Dim i As Long
Dim ab, ac, ad, emTo, emCC As String
Dim PdfFile As String, Title As String
Dim OutlApp As Object

mypath = ActiveWorkbook.Path

Application.ScreenUpdating = False

emTo = Worksheets("Inputs").Range("T5").Value
emCC = Worksheets("Inputs").Range("T7").Value
TheTitle = Worksheets("Inputs").Range("AE2").Value

Set xSht = ThisWorkbook.Sheets("Payslip")

' Not sure for what the Title is
Title = TheTitle
TitleF = TheTitle

' Title & " - " & ab
' Define PDF filename
'PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = TheTitle & ".pdf"

' PdfFile
' Export activesheet as PDF

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

' 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 = TitleF
.To = emTo ' <-- Put email of the recipient here
.CC = emCC ' <-- Put email of 'copy to' recipient here
.HTMLBody = "Greetings " & Range("T1").Value & ", " & vbLf _
& " Please find attached the medical Gas dashboard for your information and action if needed." & vbCrLf _
& "<p>" _
& "<p><p>Thank you and Best Regards,<br>" & vbLf _
& "<b>Payroll Department - Human Resources Group</b> <br>" & vbLf _
& " Phone: 7333 <br>" & vbLf _
& " Email: HR-Dept@sdl.com.sa"

.Attachments.Add mypath & "\" & PdfFile & ".pdf"

' Try to send
On Error Resume Next
Set .SendUsingAccount = OutlApp.Session.Accounts.Item(2) 'Use 2nd Account in the list

.send
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s"

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

Application.ScreenUpdating = True
End Sub

 

[daverunt]

As you are exporting the file as .pdf you probably need to remove the & ".pdf" from the Attachments.add

Or you can add a MsgBox (mypath & "\" & PdfFile & ".pdf") prior to the email section so you can see the problem

 

[countryfan_nt]

Hi again =) still stuck sorry. Please help edit the code, I did make some changes, but no still stuck.

Sub EMAIL()

' Shell ("OUTLOOK")

Dim IsCreated As Boolean
Dim i As Long
Dim ab, ac, ad, emTo, emCC As String
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim oOutlook As Object
    Dim OutAPP As Object

    On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If oOutlook Is Nothing Then
Set oOutlook = CreateObject("Outlook.Application")
Shell ("OUTLOOK")

End If

' Set OutAPP = GetObject(, "Outlook.Application")

Application.ScreenUpdating = False

emTo = Worksheets("Inputs").Range("T5").Value
emCC = Worksheets("Inputs").Range("T7").Value
TheTitle = Worksheets("Inputs").Range("AE2").Value

Set xSht = ThisWorkbook.Sheets("Payslip")

' Not sure for what the Title is
Title = TheTitle
TitleF = TheTitle

' Title & " - " & ab
' Define PDF filename
'PdfFile = ActiveWorkbook.FullName

PdfFile = ActiveWorkbook.FullName

i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)

PdfFile = TitleF & ".pdf"

' PdfFile
' Export activesheet as PDF

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

' 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 = TitleF
.To = emTo ' <-- Put email of the recipient here
.CC = emCC ' <-- Put email of 'copy to' recipient here
.HTMLBody = "Greetings " & Range("T1").Value & ", " & vbLf _
& "<p>" _
& " Please find the attached Monthly Payslip." & vbCrLf _
& "<p>" _
& "<p><p>Thank you and Best Regards,<br>" & vbLf _
& "<p>" _
& "<b>Payroll Department - Human Resources Group</b> <br>" & vbLf _
& " Phone: 7333 <br>" & vbLf _
& " Email: HR-Dept@sdl.com.sa"

.Attachments.Add PdfFile

' Try to send
On Error Resume Next
Set .SendUsingAccount = OutlApp.Session.Accounts.Item(2) 'Use 2nd Account in the list

.send
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s"

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

Application.ScreenUpdating = True
End Sub

 

[countryfan_nt]

Hello there, I tried this code! no bugs! but no emails in outlook, nothing is appearing in outlook.
Can you please help me fix it?

Sub old()

'Do not forget to change the email ID
'before running this code
Sheets("Payslip").Select

    Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim TempFileName As String
    Dim FileFullPath As String

    With Application
.ScreenUpdating = False
.EnableEvents = False
    End With

    emTo = Worksheets("Inputs").Range("T5").Value
emCC = Worksheets("Inputs").Range("T7").Value
    TheTitle = Worksheets("Inputs").Range("AE2").Value

' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.

    TempFilePath = Environ$("temp") & "\"

' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.

    TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"

'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName

'Now Export the Activesshet as PDF with the given File Name and path

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

'Now open a new mail

    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)

    On Error Resume Next
With NewMail
.To = emTo
.CC = emCC
.BCC = ""
.Subject = TheTitle
.HTMLBody = "Greetings " & Range("T1").Value & ", " & vbLf _
& "<p>" _
& " Please find the attached Monthly Payslip." & vbCrLf _
& "<p>" _
& "<p><p>Thank you and Best Regards,<br>" & vbLf _
& "<p>" _
& "<b>Payroll Department - Human Resources Group</b> <br>" & vbLf _
& " Phone: 7333 <br>" & vbLf _
& " Email: HR-Dept@sdl.com.sa"

.Attachments.Add strTempFile

' Try to send
On Error Resume Next
Set .SendUsingAccount = OutlApp.Session.Accounts.Item(1) 'Use 2nd Account in the list

.send
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s"

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

Application.ScreenUpdating = True
 Sheets("Inputs").Select

End Sub

 

[MrTomasz]

Try to change .send to .display to see if the email is generated

 

[John_w]

Change:

.Attachments.Add strTempFile

to:

.Attachments.Add FullFilePath

And comment out On Error Resume Next and see if any errors occur.