Hi,

I am new to VBA and am having some issues with the below code. Currently I have a Command Button set up to PDF the active excel sheet, save it to the home location of the document, and then attach it to an email and send to a list of people.

This document will be shared across the business, and during testing on another computer found that the code coloured red below, did not work, instead coming up with Run Time Error 1004: Document no saved. The document may be open, or an error may have been encountered when saving.

When setting up the home location, I have ensured to have this as a common location that has no permissions to access, and is the same across the business. I thought it may have been the formatting on the date, but have worked repeatedly on my own computer.

Any help would be greatly appreciated. Thanks


Private Sub CommandButton2_Click()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  
    Dim strFilename     As String
    Dim rngRange        As Range
    Dim strSaveToDirectory   As String
    Dim x     As Date
    
x = Format(Now, "dd-MMM-yyyy")
    


Title = Range("I4")
 
  ' where you need to pick file name
Set rngRange = Worksheets("DWS").Range("I4")
    'Create File name
strFilename = rngRange.Value & "_" & "DWS" & "_" & x
    'Subfolder for saving
strSaveToDirectory = ThisWorkbook.Path & Application.PathSeparator


  


Application.ScreenUpdating = False
 myFilename = strSaveToDirectory & strFilename
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=myFilename, _
    OpenAfterPublish:=False
Application.ScreenUpdating = True


  
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strSaveToDirectory & strFilename & ".pdf", 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 & " DWS"
    .To = Worksheets("DWS").Range("B5").Value   ' <-- Put email of the recipient here
 '   .CC = "Mobilisation" & ";" & Worksheets("DWS").Range("F5").Value ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "Please find attached your copy of signed DWS in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add myFilename & ".pdf"
   
    ' 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
 
 
  ' 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