There are several issues here that you might not have considered.
First the question you asked. The path to the User's documents folder is
Code:
strFolderpath = Environ("USERPROFILE") & "\Documents\"
Note especially the '\' at the end of the path. Your macro is using the documents parent folder i.e. "C:\Users\ProgramSam\"
You haven't considered that the message may have a graphic e.g. in the user's signature and that will be classed as an attachment. It is better to loop through the attachments and look for the one you require.
Worst of all the Outlook events are unreliable when more than one e-mail arrives in the folder.
It would be much better to establish why the script is not working. The following script will do what your macro intends when run from a rule. I cannot imagine what your company might have done that allows you to create macros, but doesn't allow a script to run from a rule - but if they have done something of that nature, you need to take it up with the company's IT support.
See
http://www.gmayor.com/create_and_employ_a_digital_cert.htm
Code:
Public Sub SaveAttachment(ByVal Item As MailItem)
Dim objAttachment As Outlook.Attachment
Dim strFolderpath As String
Dim strFile As String
' Get the path to your My Documents folder
strFolderpath = Environ("USERPROFILE") & "\Documents\"
If InStr(Item.Subject, "PSD") > 0 Then
If Item.Attachments.Count > 0 Then
For Each objAttachment In Item.Attachments
If Right(LCase(objAttachment.fileName), 5) = ".xlsx" Then
' Combine with the path to the folder.
strFile = strFolderpath & "PS.xlsx"
objAttachment.SaveAsFile strFile
Exit For
End If
Next objAttachment
End If
End If
Set objAttachment = Nothing
End Sub