Run a script disappeared, now what?

ProgramSam · #1 02-18-2018, 04:32 PM

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

gmayor · #2 02-18-2018, 10:05 PM

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

ProgramSam · #3 02-19-2018, 05:00 AM

Thank you, I will give this a go.

It was basically an update from an older version and when the update occurred, this feature was stripped out.

There are several examples of people seeing this as running a script is considered a security threat.

Quote:

Originally Posted by gmayor

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

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Newbie - Help - VBA script	jajukhan	Word VBA	1	11-04-2017 10:23 AM
Script Template	__John__	Word	0	06-24-2016 02:41 PM
Help with VBA script	nsyrax	Word VBA	1	01-18-2014 03:38 AM
Outlook Script Help	TheInfinetGroup	Outlook	1	03-02-2013 07:43 AM
Look in box disappeared. Please help!	padbon	PowerPoint	0	12-21-2009 02:09 PM