Solved

Need help with Outlook 2010 script

Posted on 2014-01-27
18
552 Views
Last Modified: 2014-01-29
Greeting Experts,

I am in need of some help with a script.

Purpose of the script:  The script is used to detach the attachment (i.e. pdf, csv, xml) from the email and save it on a network drive. Using a rule to automatically execute the script, I am able to copy the csv files in to a network file share.


Script current configuration:  The Outlook rule points to one outlook folder (called Region2) and pulls all attachment files(based on Subject filed)  and then saves it in network folder.

Sub SaveToFolder(MyMail As MailItem)
Dim strID As String
Dim objNS As Outlook.NameSpace
Dim objMail As Outlook.MailItem
Dim objAtt As Outlook.Attachment
Dim c As Integer
Dim save_name As String
'Place path to sav to on next line. Note that you must include the
'final backslash
Const save_path As String = "\\Network share\"

strID = MyMail.EntryID
Set objNS = Application.GetNamespace("MAPI")
Set objMail = objNS.GetItemFromID(strID)

If objMail.Attachments.Count > 0 Then
For c = 1 To objMail.Attachments.Count
Set objAtt = objMail.Attachments(c)
save_name = Left(objAtt.FileName, Len(objAtt.FileName) - 5)
save_name = save_name & Format(objMail.ReceivedTime, "_mm-dd-yyyy")
save_name = save_name & Right(objAtt.FileName, 5)
objAtt.SaveAsFile save_path & save_name

Next
End If

Set objAtt = Nothing
Set objMail = Nothing
Set objNS = Nothing
End Sub
Sub Region1()

End Sub

Open in new window


What I wanting to do:  I am looking to upgrade the script to pull attachments from 3 different outlook folders (i.e.  Region1, Region2, and Region3) and place them in to their respective (based on email address and subject line) folders on the network share named “ Region 1, Region 2, and Region 3."

Is this possible to with the current script or do I need to scarp it….
0
Comment
Question by:amstoots
  • 10
  • 8
18 Comments
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
I fully understand that you may want a script to do this, but I have had good luck with this tool for nearly the same task:

http://www.outlookfreeware.com/en/products/all/OutlookAttachmentsReplace/

~bp
0
 

Author Comment

by:amstoots
Comment Utility
thanks for your recommendation, but I looking for something that would be able to read the creation date of the .csv file and save it with the "_yyyy-dd-mm" on the end of the document...
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
What exactly do you mean by:
The Outlook rule points to one outlook folder (called Region2)
~bp
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
It feels like you should be able to do it with the same single Sub, just use the objMail.Parent property to get a handle to the containing folder of the message being processed, check it's name, and select the destination file directory based on the folder name.

~bp
0
 

Author Comment

by:amstoots
Comment Utility
yes..The file name "Region2" is the folder name in Outlook where I move the email with the attachment in question . I attempted to create multiple Projects ( i.e. Project1Region2(vbaproject.otm) in the VBA application (ALT-F11) and then just point rule for each one one of the outlook folders " Region1, Region2, and Region 3" in outlook...


how would I use it with the objmail.Parent in my current script..... I just starting to learn scripting..
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
And how do you:
point rule for each one one of the outlook folders " Region1, Region2, and Region 3" in outlook
~bp
0
 

Author Comment

by:amstoots
Comment Utility
I need to move each attachments to there own network folders ( Region 1, Region 2, and Region 3 ) from each of the outlook folders ( Region1, Region2, and Region3)  inside of the outlook client.. in the same script

outlook folder Region1 to  network folder Region 1
outlook folder Region2 to  network folder Region 2
outlook folder Region3 to  network folder Region 3
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Yes, I understand that part, but you keep indicating you have the ability to connect a certain rule to a particular Outlook folder, I was interested in how you set that up.

~bp
0
 

Author Comment

by:amstoots
Comment Utility
Steps for setting up a Custom rule in outlook...

1. Open up outlook

2.  Highlight the email you want to run the rule.

3.  Select Rule> New Rule

4.  Create Rule window will popup.  Place check mark next to user name and subject
  pic1
5   Select the advanced> make sure those two items are check …
pic2
6. Select Next again and check “script”> click on the script you wish to use> click the ok button.
pic3
pic4
7. Click on the Next button and you will have created a rule in outlook…  pic5
pic6
This is the basic setup for a custom rule
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Okay, thanks.  Just so we are clear, I think that approach executes the rle when incoming emails hit the Inbox, not an individual folder though.  But it sounds like there is something in either the FROM field or the SUBJECT field that we could look at to know which region the email applies to, and therefore what directory on disk the attached file gets saved to?

How do the emails themselves get moved to the separate Outlook folders currently, based on the region?

~bp
0
 

Author Comment

by:amstoots
Comment Utility
yes, they are moved based on the Region they come from and they are saved in each of there own outlook folders " Region1, Region2, and Region3
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Okay, it looks like the sender name has the region number in it, so I think this approach would work.  It looks at the left part of the sender name and sets the destination folder based on the region.  Make sure you create the 3 region folders, and the "Other" folder under the root folder.  Emails where the sender doesn't match one of the three regions will have their attachments placed in the "Other" directory.

Sub SaveToFolder(MyMail As MailItem)
   ' Define all needed variables
   Dim strID As String
   Dim objNS As Outlook.NameSpace
   Dim objMail As Outlook.MailItem
   Dim objAtt As Outlook.Attachment
   Dim strSavePath As String
   Dim strSaveName As String
   Dim i As Integer

   'Place path to sav to on next line. Note that you must include the final backslash
   Const strSaveRoot As String = "\\Network share\"

   ' Access the email being processed currently
   strID = MyMail.EntryID
   Set objNS = Application.GetNamespace("MAPI")
   Set objMail = objNS.GetItemFromID(strID)

   ' If we have attachements, then save them to disk
   If objMail.Attachments.Count > 0 Then

      ' Determine the folder on disk based on the left part of the sender name
      Select Case LCase(Left(objMail.SendreName, 7))
         Case "region1"
            strSavePath = strSaveRoot & "Region1\"
         Case "region2"
            strSavePath = strSaveRoot & "Region2\"
         Case "region3"
            strSavePath = strSaveRoot & "Region3\"
         Case Else
            strSavePath = strSaveRoot & "Other\"
      End Select

      ' Save each attachement, adding a date stamp to the file name on disk
      For i = 1 To objMail.Attachments.Count
         Set objAtt = objMail.Attachments(i)
         strSaveName = Left(objAtt.FileName, Len(objAtt.FileName) - 5)
         strSaveName = strSaveName & Format(objMail.ReceivedTime, "_mm-dd-yyyy")
         strSaveName = strSaveName & Right(objAtt.FileName, 5)
         objAtt.SaveAsFile strSavePath & strSaveName
      Next
   End If

   ' Release objects
   Set objAtt = Nothing
   Set objMail = Nothing
   Set objNS = Nothing
End Sub

Open in new window

~bp
0
 

Author Comment

by:amstoots
Comment Utility
billprew - the script worked perfect and I am able move attachments based on the instance of Region1, Region2, Region3, or other.....  I do have one additional question. when the server attempts to use the following string Below. Is there a way to have it push the attachment to one of 3 different network shares ( i.e   \\Network Share\Region 1\,  \\Network Share\Region 2\, or \\Network Share\Region 3, etc) based on the Region1, Region2, or Region3 outlook folder indicated in the script......    


'Place path to sav to on next line. Note that you must include the final backslash
   Const save_path As String = "\\Network Share\Region 1\"

Open in new window

0
 
LVL 51

Accepted Solution

by:
Bill Prew earned 500 total points
Comment Utility
Maybe it would be best to just specify the full server, share and path for each region in the CASE, as below (adjust as needed):

Sub SaveToFolder(MyMail As MailItem)
   ' Define all needed variables
   Dim strID As String
   Dim objNS As Outlook.NameSpace
   Dim objMail As Outlook.MailItem
   Dim objAtt As Outlook.Attachment
   Dim strSavePath As String
   Dim strSaveName As String
   Dim i As Integer

   ' Access the email being processed currently
   strID = MyMail.EntryID
   Set objNS = Application.GetNamespace("MAPI")
   Set objMail = objNS.GetItemFromID(strID)

   ' If we have attachements, then save them to disk
   If objMail.Attachments.Count > 0 Then

      ' Determine the folder on disk based on the left part of the sender name
      Select Case LCase(Left(objMail.SendreName, 7))
         Case "region1"
            strSavePath = "\\Network share\Region1\"
         Case "region2"
            strSavePath = "\\Network share\Region2\"
         Case "region3"
            strSavePath = "\\Network share\Region3\"
         Case Else
            strSavePath = "\\Network share\Other\"
      End Select

      ' Save each attachement, adding a date stamp to the file name on disk
      For i = 1 To objMail.Attachments.Count
         Set objAtt = objMail.Attachments(i)
         strSaveName = Left(objAtt.FileName, Len(objAtt.FileName) - 5)
         strSaveName = strSaveName & Format(objMail.ReceivedTime, "_mm-dd-yyyy")
         strSaveName = strSaveName & Right(objAtt.FileName, 5)
         objAtt.SaveAsFile strSavePath & strSaveName
      Next
   End If

   ' Release objects
   Set objAtt = Nothing
   Set objMail = Nothing
   Set objNS = Nothing
End Sub

Open in new window

~bp
0
 

Author Comment

by:amstoots
Comment Utility
Thanks for the advice on the updated script... When I did try to use it with Outlook rule. it would attempt to run but failed w/o any error messages . I verified the email address is correct and the file patch going to the individual network folders.  any ideas...

Sub SaveToFolder(MyMail As MailItem)
   ' Define all needed variables
   Dim strID As String
   Dim objNS As Outlook.NameSpace
   Dim objMail As Outlook.MailItem
   Dim objAtt As Outlook.Attachment
   Dim strSavePath As String
   Dim strSaveName As String
   Dim i As Integer

   ' Access the email being processed currently
   strID = MyMail.EntryID
   Set objNS = Application.GetNamespace("MAPI")
   Set objMail = objNS.GetItemFromID(strID)

   ' If we have attachements, then save them to disk
   If objMail.Attachments.Count > 0 Then

      ' Determine the folder on disk based on the left part of the sender name
      Select Case LCase(Left(objMail.SendreName, 7))
         Case "region1"
            strSavePath = "\\xx.xx.xx.xx\home_hlichrvaw3-ad1\UserAccount\Folder1\Region1\"
         Case "region2"
            strSavePath = "\\xx.xx.xx.xx\home_hlichrvaw3-ad1\UserAccount\Folder1\Region2\"
         Case "region3"
            strSavePath = "\\xx.xx.xx.xx\home_hlichrvaw3-ad1\UserAccount\Folder1\Region3\"
      End Select

      ' Save each attachement, adding a date stamp to the file name on disk
      For i = 1 To objMail.Attachments.Count
         Set objAtt = objMail.Attachments(i)
         strSaveName = Left(objAtt.FileName, Len(objAtt.FileName) - 5)
         strSaveName = strSaveName & Format(objMail.ReceivedTime, "_mm-dd-yyyy")
         strSaveName = strSaveName & Right(objAtt.FileName, 5)
         objAtt.SaveAsFile strSavePath & strSaveName
      Next
   End If

   ' Release objects
   Set objAtt = Nothing
   Set objMail = Nothing
   Set objNS = Nothing
End Sub

Open in new window

 


outlook7picoutlookpic8outlookpic9
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Well, I do see one problem, it looks like this line:

      Select Case LCase(Left(objMail.SendreName, 7))

should be:

      Select Case LCase(Left(objMail.SenderName, 7))

~bp
0
 

Author Closing Comment

by:amstoots
Comment Utility
That did the trick billprew -- thank you for your help ......  :)
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Welcome, thanks for the feedback.

~bp
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

This script checks a path to see if a folder exists. If the folder does exist you will get output "The folder has previously been created. No action taken" If not it will create the folder. Then adds one user modify permission to the folder. It …
This article explains how to prepare an HTML email signature template file containing dynamic placeholders for users' Azure AD data. Furthermore, it explains how to use this file to remotely set up a department-wide email signature policy in Office …
The viewer will learn how to count occurrences of each item in an array.
This tutorial will teach you the core code needed to finalize the addition of a watermark to your image. The viewer will use a small PHP class to learn and create a watermark.

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now