VBA excel range export to PDF, save and email using outlook not working

Question

I have a macro where I can export an Excel range to PDF and save which works fine. I have another one to export an Excel range to PDF, save & email with Outlook, which I cannot get to work. It can't find the file folder to save the PDF to and it won't attach in email. I can't figure out what is causing the issue.

Sub Clickticketsaveemail1b1s()
    Dim saveLocation As String
    Dim rng As Range
    
    saveLocation = "T:\Department\Investment Sales\_Restricted\TRADING\TRADE TICKETS"
    Set rng = Sheets("Trade Ticket").Range("A1:G61")
    FileName = Sheets("Trade Ticket").Range("R1").Value & ".pdf"
    
    SaveAsStr = ActiveWorkbook.Path & "\" & Sheets("Trade Ticket").Range("R1").Value
    rng.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Sheets("Trade Ticket").Range("R1").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    Dim xSht As Worksheet
    Dim xFileDlg As FileDialog
    Dim xFolder As String
    Dim xYesorNo As Integer
    Dim xOutlookObj As Object
    Dim xEmailObj As Object
    Dim xUsedRng As Range
    
    Set xSht = ActiveSheet
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
     
    If xFileDlg.Show = True Then
       xFolder = xFileDlg.SelectedItems("TRADE TICKETS")
    Else
       MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
       Exit Sub
    End If
    xFolder = xFolder + "\" + xSht.Name + ".pdf"
     
    'Check if file already exist
    If Len(Dir("T:\Department\Investment Sales\_Restricted\TRADING\TRADE TICKETS\" & Sheets("Trade Ticket").Range("R1").Value) & ".pdf") > 0 Then
        xYesorNo = MsgBox(Sheets("Trade Ticket").Range("R1") & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                          vbYesNo + vbQuestion, "File Exists")
        On Error Resume Next
        If xYesorNo = vbYes Then
            Kill xFolder
        Else
            MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                        & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
            Exit Sub
        End If
        If Err.Number <> 0 Then
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                        & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
            Exit Sub
        End If
    End If
     
    Set xUsedRng = xSht.UsedRange
    If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
        'Save as PDF file
        xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, Quality:=xlQualityStandard
         
        'Create Outlook email
        Set xOutlookObj = CreateObject("Outlook.Application")
        Set xEmailObj = xOutlookObj.CreateItem(0)
        With xEmailObj
            .Display
            .To = ""
            .CC = "" & ""
            .Subject = FileName
            .myattachments.Add PathFileName
            If DisplayEmail = False Then
                '.Send
            End If
        End With
    Else
      MsgBox "The active worksheet cannot be blank"
      Exit Sub
    End If
End Sub

Answer 1

I have a macro where I can export an Excel range to PDF and save which works fine. I have another one to export an Excel range to PDF, save & email with Outlook, which I cannot get to work. It can't find the file folder to save the PDF to and it won't attach in email. I can't figure out what is causing the issue.

Sub Clickticketsaveemail1b1s()
    Dim saveLocation As String
    Dim rng As Range
    
    saveLocation = "T:\Department\Investment Sales\_Restricted\TRADING\TRADE TICKETS"
    Set rng = Sheets("Trade Ticket").Range("A1:G61")
    FileName = Sheets("Trade Ticket").Range("R1").Value & ".pdf"
    
    SaveAsStr = ActiveWorkbook.Path & "\" & Sheets("Trade Ticket").Range("R1").Value
    rng.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Sheets("Trade Ticket").Range("R1").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    Dim xSht As Worksheet
    Dim xFileDlg As FileDialog
    Dim xFolder As String
    Dim xYesorNo As Integer
    Dim xOutlookObj As Object
    Dim xEmailObj As Object
    Dim xUsedRng As Range
    
    Set xSht = ActiveSheet
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
     
    If xFileDlg.Show = True Then
       xFolder = xFileDlg.SelectedItems("TRADE TICKETS")
    Else
       MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
       Exit Sub
    End If
    xFolder = xFolder + "\" + xSht.Name + ".pdf"
     
    'Check if file already exist
    If Len(Dir("T:\Department\Investment Sales\_Restricted\TRADING\TRADE TICKETS\" & Sheets("Trade Ticket").Range("R1").Value) & ".pdf") > 0 Then
        xYesorNo = MsgBox(Sheets("Trade Ticket").Range("R1") & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                          vbYesNo + vbQuestion, "File Exists")
        On Error Resume Next
        If xYesorNo = vbYes Then
            Kill xFolder
        Else
            MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                        & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
            Exit Sub
        End If
        If Err.Number <> 0 Then
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                        & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
            Exit Sub
        End If
    End If
     
    Set xUsedRng = xSht.UsedRange
    If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
        'Save as PDF file
        xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, Quality:=xlQualityStandard
         
        'Create Outlook email
        Set xOutlookObj = CreateObject("Outlook.Application")
        Set xEmailObj = xOutlookObj.CreateItem(0)
        With xEmailObj
            .Display
            .To = ""
            .CC = "" & ""
            .Subject = FileName
            .myattachments.Add PathFileName
            If DisplayEmail = False Then
                '.Send
            End If
        End With
    Else
      MsgBox "The active worksheet cannot be blank"
      Exit Sub
    End If
End Sub

Answer 2

I have a macro where I can export an Excel range to PDF and save which works fine. I have another one to export an Excel range to PDF, save & email with Outlook, which I cannot get to work. It can't find the file folder to save the PDF to and it won't attach in email. I can't figure out what is causing the issue.

Sub Clickticketsaveemail1b1s()
    Dim saveLocation As String
    Dim rng As Range
    
    saveLocation = "T:\Department\Investment Sales\_Restricted\TRADING\TRADE TICKETS"
    Set rng = Sheets("Trade Ticket").Range("A1:G61")
    FileName = Sheets("Trade Ticket").Range("R1").Value & ".pdf"
    
    SaveAsStr = ActiveWorkbook.Path & "\" & Sheets("Trade Ticket").Range("R1").Value
    rng.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Sheets("Trade Ticket").Range("R1").Value & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    Dim xSht As Worksheet
    Dim xFileDlg As FileDialog
    Dim xFolder As String
    Dim xYesorNo As Integer
    Dim xOutlookObj As Object
    Dim xEmailObj As Object
    Dim xUsedRng As Range
    
    Set xSht = ActiveSheet
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
     
    If xFileDlg.Show = True Then
       xFolder = xFileDlg.SelectedItems("TRADE TICKETS")
    Else
       MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
       Exit Sub
    End If
    xFolder = xFolder + "\" + xSht.Name + ".pdf"
     
    'Check if file already exist
    If Len(Dir("T:\Department\Investment Sales\_Restricted\TRADING\TRADE TICKETS\" & Sheets("Trade Ticket").Range("R1").Value) & ".pdf") > 0 Then
        xYesorNo = MsgBox(Sheets("Trade Ticket").Range("R1") & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                          vbYesNo + vbQuestion, "File Exists")
        On Error Resume Next
        If xYesorNo = vbYes Then
            Kill xFolder
        Else
            MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                        & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
            Exit Sub
        End If
        If Err.Number <> 0 Then
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                        & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
            Exit Sub
        End If
    End If
     
    Set xUsedRng = xSht.UsedRange
    If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
        'Save as PDF file
        xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, Quality:=xlQualityStandard
         
        'Create Outlook email
        Set xOutlookObj = CreateObject("Outlook.Application")
        Set xEmailObj = xOutlookObj.CreateItem(0)
        With xEmailObj
            .Display
            .To = ""
            .CC = "" & ""
            .Subject = FileName
            .myattachments.Add PathFileName
            If DisplayEmail = False Then
                '.Send
            End If
        End With
    Else
      MsgBox "The active worksheet cannot be blank"
      Exit Sub
    End If
End Sub