Attaching pdf causing crashing

[tismail]

Hello

I have an issue with below code. It does work perfectly but it keep freezing and crashing every few seconds later. Any help would be appreciated..
Thank You





Sub Save_as_PDF()

Application.ScreenUpdating = False

'Hide blank rows
For Each c In Range("C2:C38")
If c.Value = "" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next

'Hide Senior and Loyalty columns
Columns("G:H").Hidden = True

'Set path to Reports folder
fPath = "T:\Ollie\Sunshine Club\Sunshine Club Sales\Reports\Sunshine Club Sales "

'Build File Name from Sheet2
Sheets(2).Range("B6").NumberFormat = "dd-mm-yy"
fName = Sheets(2).Range("B6").Text

'Save as PDF in Reports folder with date
Sheets("Sheet1").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

Application.ScreenUpdating = True

End Sub


Sub Email_Order_Send_Emails()

Application.ScreenUpdating = False
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
Subject = Range("Sheet2!B4")
Selected = Range("Sheet2!B7")
Recipient = Range("Sheet2!B1")
CC = Range("Sheet2!B2")
BCC = Range("Sheet2!B3")
Body = Range("Sheet2!B5")


TempFilePath = "C:\"
tempfilename = TempFilePath & Subject & ".pdf"

' Export activesheet as PDF
With Sheets(Selected)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=tempfilename, 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 = Subject
.To = Recipient ' <-- Put email of the recipient here
.CC = CC ' <-- Put email of 'copy to' recipient here
.BCC = BCC
.Body = Body
.Attachments.Add tempfilename
.Display

' 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 tempfilename

' 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


Sub Reset()
'Unhide Senior and Loyalty columns
Sheets("Sheet1").Columns("G:H").Hidden = False

'Unhide blank rows
Sheets("Sheet1").Rows("2:38").EntireRow.Hidden = False



End Sub