Greetings, in the spirit of efficiency, I had scripts/Inbox rules that would execute when specific e-mails would transmit to my inbox. When a specific e-mail would arrive every morning, with a specific attachment, it would automatically save the file to a designated folder on my desktop. Recently my company made an update to Outlook 365 and when the transition occurred, I was no longer able to 'Run a Script' and where you cannot edit the registry, I'd like to be able to have the ability to rework the coding to make this work. Thus, the script below...
The script triggers when an e-mail comes in with the letter sequence PSD in the subject line however, I cannot get the attachment to save to the designated folder. I think I'm close but am having a difficult time getting over the hump. Thoughts?
Code:
Private Sub Application_NewMail()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttachments As Outlook.Attachments
Dim strFolderpath As String
Dim strFile As String
Dim sFileType As String
Set objAttachments = Item.Attachments
' Get the file name.
strFile = objAttachments.Item(1).fileName
' Get the path to your My Documents folder
strFolderpath = ("C:\Users\ProgramSam\Documents")
' Combine with the path to the folder.
strFile = strFolderpath & "PS.XLSX"
On Error Resume Next
If InStr(Item.Subject, "PSD") > 0 Then
objAttachments.SaveAsFile strFile
End If
End Sub