Sende 2 sheets som pdf vedhæftet email

Jeg prøver at sende 2 sheets som pdf vedhæftet til en email, men koden gør ikke hvad den skal. De 2 pdf filer dannes ikke på n:\ og koden fejler derfor når den når til attachments.add kommandoen.

Derudover er der sikkert også en smartere metode til at få vedhæftet de 2 sheets end at bruge select og derefter activesheet.

Sub pdfemailtilleder()
  Dim IsCreated As Boolean
  Dim i, i2 As Long, DesktopPath As String
  Dim PdfFile, Pdffile2 As String, Title As String
  Dim OutlApp As Object
   
  Application.enableevents = False
  Application.DisplayAlerts = False
 
  PdfFile = Ansættelsesbrev 'ActiveWorkbook.FullName
  Pdffile2 = Forhandlingsreferat 'ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  i2 = InStrRev(Pdffile2, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  If i2 > 1 Then Pdffile2 = Left(Pdffile2, i - 1)
  PdfFile = PdfFile & ".pdf" '"_" & ActiveSheet.Name & ".pdf"
  Pdffile2 = Pdffile2 & ".pdf" '"_" & ActiveSheet.Name & ".pdf"

  Set WSHShell = CreateObject("WScript.Shell")
    Set WSHShell = Nothing

  ThisWorkbook.SaveAs FileName:="N:" & "\Ansættelsesbrev.xltm"    '"N:" & "\" & ActiveWorkbook.Name

  Sheets("Ansættelsesbrev").Select
  With ActiveSheet
      .ExportAsFixedFormat Type:=xlTypePDF, FileName:="Ansættelsesbrev", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  Sheets("forhandlingsreferat").Select
  With ActiveSheet
      .ExportAsFixedFormat Type:=xlTypePDF, FileName:="Forhandlingsreferat", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  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

  With OutlApp.CreateItem(0)
    .Subject = "Ansættelsesbrev og forhandlingsreferat
    .To = ""
    .CC = "" '
    .Body = "Hej" & Chr(13) & Chr(13) & "Ansættelsesbrev og forhandlingsreferat til godkendelse."
    .Attachments.Add PdfFile
    .Attachments.Add Pdffile2
 
    On Error Resume Next
    .Display
    On Error GoTo 0
 
  End With

  Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing

Application.enableevents = True
Application.DisplayAlerts = True
End Sub