Hi

i am trying to adapt a code, to create and email a pdf to include the option to select where to save the file. I keep getting a runtime error 1004 Getsaveasfilename of object application failed.


Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Dim IntialName As String
  Dim fileSaveName As Variant
  
   With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set ws = Sheets("Open day letter")

    Set rng = ws.Range("B8:J274")
   
    Title = Range("c6").Text & "_" & Range("B1") & "_" & Format(Now(), "DD-MM-YYYY")
    
    InitialName = Range("c6").Text & "_" & Range("B1") & "_" & Format(Now(), "DD-MM-YYYY") & ".PDF"
  
    fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, _
    fileFilter:="PDF Files (*.PDF")
    If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName
    End If
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, 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 = Title
    .To = Range("E6")
    .CC = ""
    .BCC = ""
    .Subject = Range("C6").Value & " , " & Range("C18").Value & " , " & Range("B2").Value
    .Body = Range("C20").Text & vbNewLine & " " & vbNewLine & "I am pleased to invite you along to our pump open day and have attached the necessary details.." & vbNewLine & " " & vbNewLine & "I would be grateful if you confirm attendence in the next 10 days.  In the meantime if you have any questions please do not hesitate to contact me."
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    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 PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub
Any help much appreciated.