Solved

Outlook Script

Posted on 2013-12-05
18
670 Views
Last Modified: 2013-12-12
Only a daily basis, I receive more than 10 to 20 reports from 12 people… that I have open and save the .csv document to different network drives. I have a separate folder in my outlook for each person who sends me the attachment. I have to spend more than hour every morning opening and saving each excel document to their respective network drive. This is where my problem begins… I am in search script that can pull each the attachment from outlook folder, change the .csv to .xls, and save it to its respective network drive.
      I don’t know if this is possible, but I thought I would put the question out there and see if somebody can direct me to script or help me create one that I can use my version of Windows outlook 2010….. Is this possible….?
0
Comment
Question by:amstoots
  • 6
  • 6
  • 5
  • +1
18 Comments
 
LVL 53

Expert Comment

by:Will Szymkowski
ID: 39700122
Take a look at the following link as it provides a method to do this via powershell.

http://chris.dziemborowicz.com/blog/2013/05/18/how-to-batch-extract-attachments-from-msg-files-using-powershell/

Will.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39700157
You can also do this in VBA such that it will do the action automatically for you (No separate script to run).  You will need to change some values in the code to work for your setup.  For instance I set up my test code to route specific messages to a folder in my personal files called "trash".  You will need to update that line for whatever folder you want to watch.  The code then looks for any new mail item added to that folder.  If it has a .csv attacment it saves it off.  You will need to update the path to the correct path.  

This code will need to go into the ThisOutlookSession module.

Dim WithEvents AttachmentFolderItems As Outlook.Items
Private Sub Application_Startup()
    Dim objNameSpace As Outlook.NameSpace
    Dim objNewItems As Outlook.Items
    Dim objFolders As Outlook.Folder
    
    ' Get Access to Outlook Folders
    Set objNameSpace = Outlook.GetNamespace("MAPI")
    
    ' Get the particular folder we want to watch
    Set objFolders = objNameSpace.Folders("Personal Folders").Folders("trash")
    
    ' Set up the item object so that it triggers the Item Add Event
    Set AttachmentFolderItems = objFolders.Items
    
End Sub

Private Sub AttachmentFolderItems_ItemAdd(ByVal Item As Object)
    Dim objAttachment As Outlook.Attachment
    Dim objFSO As Scripting.FileSystemObject
    Dim strNewName As String
    
    ' Use the FileSystemObject to get the extension
    Set objFSO = New Scripting.FileSystemObject
    
    ' Make sure we have a mail item before proceeding
    If Item.Class = Outlook.olMail Then
        ' Loop Through any attachments and look for a csv file
        For Each objAttachment In Item.Attachments
            Debug.Print objFSO.GetBaseName(objAttachment.FileName)
            If objFSO.GetExtensionName(objAttachment.FileName) = "csv" Then
                ' Create the new file name
                strNewName = "E:\EEtest\OOTest\" & objFSO.GetBaseName(objAttachment.FileName) & ".xls"
                objAttachment.SaveAsFile (strNewName)
            End If
        Next
    End If
    
    
End Sub

Open in new window


-Bear
0
 
LVL 68

Expert Comment

by:Qlemo
ID: 39700628
Note that CSV isn't XLS, so you should not just change the file extension on save. It works, as Excel detects the real content, but you should not do that. The question is: Do you need an Excel file, or is CSV enough? E.g. it is possible to open Excel automatically with the CSV from Outlook VBA, and save as XLS(x).

Further, since you have different folders to maintain, I would use a more generic function of above:
Dim WithEvents mlItemsStaffA As Outlook.Items
Dim WithEvents mlItemsStaffB As Outlook.Items
' aso.

Private Sub Application_Startup()
    Dim objNameSpace As Outlook.NameSpace
    Dim objNewItems As Outlook.Items
    Dim objFolders As Outlook.Folder
    
    ' Get Access to Outlook Folders
    Set objNameSpace = Outlook.GetNamespace("MAPI")
    
    ' Get the particular folders we want to watch
    ' Set up the item objects so that they trigger the Item Add Event
    Set mlItemsStaffA = objNameSpace.Folders("Personal Folders").Folders("StaffA").Items
    Set mlItemsStaffB = objNameSpace.Folders("Personal Folders").Folders("StaffB").Items
    ' aso.
End Sub

Private Sub mlItemsStaffA_ItemAdd(ByVal Item As Object)
  call SaveAttachment(Item, 'StaffA\')
End Sub

Private Sub mlItemsStaffB_ItemAdd(ByVal Item As Object)
  call SaveAttachment(Item, 'StaffB\')
End Sub

Private Sub SaveAttachment(Item As Object, subfolder As String)
    Dim objAttachment As Outlook.Attachment
    Dim objFSO As Scripting.FileSystemObject
    Dim strNewName As String
    
    ' Use the FileSystemObject to get the extension
    Set objFSO = New Scripting.FileSystemObject
    
    ' Make sure we have a mail item before proceeding
    If Item.Class = Outlook.olMail Then
        ' Loop Through any attachments and look for a csv file
        For Each objAttachment In Item.Attachments
            Debug.Print objFSO.GetBaseName(objAttachment.FileName)
            If objFSO.GetExtensionName(objAttachment.FileName) = "csv" Then
                ' Create the new file name
                strNewName = "\\server\share\" & subfolder & objFSO.GetBaseName(objAttachment.FileName) & ".csv"
                objAttachment.SaveAsFile (strNewName)
            End If
        Next
    End If
End Sub

Open in new window

0
 

Author Comment

by:amstoots
ID: 39701089
First of all, thanks for all of the suggestions and script you have post on this question. I really appreciate it...  I do have one more question... Once I open the VB For applications using "ALT-F11" .. How do I set it so I can run it as a rule on my 2010 outlook client...
0
 
LVL 68

Expert Comment

by:Qlemo
ID: 39701173
Application_Startup() is called when starting Outlook (resp. the application the sub is in). To activate the code without having to restart Outlook just put the cursor somewhere into that sub, and press F5. That should execute the code, and from then on the trigger code should work automatically whenever a mail is put into one of the monitored folders.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39701244
@Qlemo - nice changes to my code.  I should have been more clear on the handling of the multiple folders.  Also, excellent point on changing the extension.

If we keep the extensions the same then I would change this code:
strNewName = "\\server\share\" & subfolder & objFSO.GetBaseName(objAttachment.FileName) & ".csv"

Open in new window

To
strNewName = "\\server\share\" & subfolder & objAttachment.FileName

Open in new window


@amstoots - You will still need your rule in outlook to move the email to your folder.  This code then watches the folder for new email and triggers the code when one arrives.  If all the attachments that will be sent to these folders are csv files or if we can assume that we can always save the attachment, then we can simplify the code even more.  The subroutine could become:
Private Sub SaveAttachment(Item As Object, subfolder As String)
    Dim objAttachment As Outlook.Attachment
    Dim strNewName As String
    
    ' Make sure we have a mail item before proceeding
    If Item.Class = Outlook.olMail Then
        ' Loop Through any attachments and look for a csv file
        For Each objAttachment In Item.Attachments
			' Create the new file name
			strNewName = "\\server\share\" & subfolder & objAttachment.FileName
			objAttachment.SaveAsFile (strNewName)
        Next
    End If
End Sub

Open in new window


As a side note, you will need to add a reference into your project to Microsoft Scripting Runtime if you keep the original code that looks for a csv file.  (We could change to the code to late binding if you like)

Also you may need to self sign your macro depending on your security settings.  This page has some old but still useful directions on how to accomplish that.  I have attached a pdf of that website just in case that link ever dies.
self-sign-macro.pdf
0
 

Author Comment

by:amstoots
ID: 39701543
ok.. I am just a little unsure here... after I open up VB for applications ( ALT+F11) , how would I add the "Application_Startup() " once I open up ThisOutlookSession... First time adding this type of code to outlook



 outlook-pic.pdf
0
 
LVL 68

Expert Comment

by:Qlemo
ID: 39701564
Double-click ThisOutlookSession - you should get an empty window. Then just past the code, but change the mail and file folders, of course.
0
 

Author Comment

by:amstoots
ID: 39701836
Ok…Another quick question, when adding the outlook folders .. Should I add the name of the Folders where is says “Set mlItemsStaffA = objNameSpace.Folders("Personal Folders")” or should It be placed at “Folders("Region1").Items”..  Also I not for sure what I should put on the following string “call SaveAttachment(Item, 'StaffA\') ”…


Current Layout of Code in VB for Applications
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39702539
Some of this assumes that the folders that you have are all personal folders in a personal .pst file.  If not, then we may need more information.

So you will need to make a copy of this line
Set mlItemsStaffA = objNameSpace.Folders("Personal Folders").Folders("StaffA").Items

Open in new window

for each folder that you have.  Replace "STaffA" with the folder name in your personal folder.  You can also rename the variable of mlItemsStaffA to something that makes more sense, but make sure you change it in all places.

Also you will need to add this sub routine for each folder (I noticed an error in this code and changed the single quotes to double quotes):
Private Sub mlItemsStaffA_ItemAdd(ByVal Item As Object)
  call SaveAttachment(Item, "StaffA\")
End Sub

Open in new window


The "StaffA\" would need to be the name of the sub folder in Windows explorer for each outlook folder where the file would be saved.  This gets combined with the line "\\server\share\" to create the path.  Please make sure that the path exists or this code will fail.  We can add code to create the path if it is required.

So for example if you had three folders in Outlook for each of us (amstoots, Qlemo, Bear) you would need this code:
Private Sub Application_Startup()
    Dim objNameSpace As Outlook.NameSpace
    Dim objNewItems As Outlook.Items
    Dim objFolders As Outlook.Folder
    
    ' Get Access to Outlook Folders
    Set objNameSpace = Outlook.GetNamespace("MAPI")
    
    ' Get the particular folders we want to watch
    ' Set up the item objects so that they trigger the Item Add Event
    Set mlItemsamstoots = objNameSpace.Folders("Personal Folders").Folders("amstoots").Items
    Set mlItemsQlemo = objNameSpace.Folders("Personal Folders").Folders("Qlemo").Items
    Set mlItemsBear = objNameSpace.Folders("Personal Folders").Folders("Bear").Items
    ' aso.
End Sub

Private Sub mlItemsamstoots_ItemAdd(ByVal Item As Object)
  call SaveAttachment(Item, "amstoots\")
End Sub

Private Sub mlItemsQlemo_ItemAdd(ByVal Item As Object)
  call SaveAttachment(Item, "Qlemo\")
End Sub

Private Sub mlItemsBear_ItemAdd(ByVal Item As Object)
  call SaveAttachment(Item, "Bear\")
End Sub

Open in new window


Then you need to make sure that where these files are going has folders for each of us.  For example:
\\192.168.1.100\csvfiles\amstoots
\\192.168.1.100\csvfiles\Qlemo
\\192.168.1.100\csvfiles\Bear

I hope this helps clarify some items.

-Bear
0
 
LVL 68

Expert Comment

by:Qlemo
ID: 39703232
(I noticed an error in this code and changed the single quotes to double quotes)
Ooops. Well put, all that, ltlbearand3.
BTW, in Outlook VBA you do not need to use
Set objNameSpace = Outlook.GetNamespace("MAPI")

Open in new window

as Outlook.Session or Session provides exactly that. Using that, the startup code would be:
Private Sub Application_Startup()
    ' Get the particular folders we want to watch
    ' Set up the item objects so that they trigger the Item Add Event
    Set mlItemsamstoots = Sessopm.Folders("Personal Folders").Folders("amstoots").Items
    Set mlItemsQlemo = Session.Folders("Personal Folders").Folders("Qlemo").Items
    Set mlItemsBear = Session.Folders("Personal Folders").Folders("Bear").Items
    ' aso.
End Sub

Open in new window


amstoots, of course you could provide the complete path instead of a subfolder if you need to store the attachments into completely different locations, or if you like to have that complete path in the call for visibility.
0
 
LVL 20

Expert Comment

by:ltlbearand3
ID: 39703703
Cool.  Thanks for the tip on the outlook.session object.  I was not aware of it.  [One of the great things about EE - I learn even when answering questions].
0
 

Author Comment

by:amstoots
ID: 39703787
Thanks for everybody help in this script so fare..... I have learned a lot so fore... currently I ran in to a problem where is not seeing the object " The Attempted operation failed. An object could not be found" It looks to be getting stuck on the first "set Set mlItemsRegion1" for some reason... I have attached script error, screenshot of my Mailbox tree on my client, and screen shot of the debug showing the string in yellow highlight. It says it not able to find the object... am i updating it incorrectly


 
Private Sub Application_Startup()
    Dim objNameSpace As Outlook.NameSpace
    Dim objNewItems As Outlook.Items
    Dim objFolders As Outlook.Folder
    
    ' Get Access to Outlook Folders
    Set objNameSpace = Outlook.GetNamespace("MAPI")
    
    ' Get the particular folders we want to watch
    ' Set up the item objects so that they trigger the Item Add Event
    Set mlItemsRegion1 = objNameSpace.Folders("Personal Folders").Folders("Region1").Items
    Set mlItemsRegion2 = objNameSpace.Folders("Personal Folders").Folders("Region2").Items
    Set mlItemsRegion3 = objNameSpace.Folders("Personal Folders").Folders("Region3").Items
    ' aso.
End Sub

Private Sub mlItemsRegion1_ItemAdd(ByVal Item As Object)
  Call SaveAttachment(Item, "Region1\")
End Sub

Private Sub mlItemsRegion2_ItemAdd(ByVal Item As Object)
  Call SaveAttachment(Item, "Region2\")
End Sub

Private Sub mlItemsRegion3_ItemAdd(ByVal Item As Object)
  Call SaveAttachment(Item, "Region3\")
End Sub

Private Sub SaveAttachment(Item As Object, subfolder As String)
    Dim objAttachment As Outlook.Attachment
    Dim strNewName As String
    
    ' Make sure we have a mail item before proceeding
    If Item.Class = Outlook.olMail Then
        ' Loop Through any attachments and look for a csv file
        For Each objAttachment In Item.Attachments
            ' Create the new file name
            strNewName = "\\10.9.41.160\home_hlichrvaw3-ad1\mstoots\Completed Reports\EPO Reports\SQL EPOReportsLast24hrs Database portal\Region 1" & subfolder & objAttachment.FileName
            strNewName = "\\10.9.41.160\home_hlichrvaw3-ad1\mstoots\Completed Reports\EPO Reports\SQL EPOReportsLast24hrs Database portal\Region 2" & subfolder & objAttachment.FileName
            strNewName = "\\10.9.41.160\home_hlichrvaw3-ad1\mstoots\Completed Reports\EPO Reports\SQL EPOReportsLast24hrs Database portal\Region 3" & subfolder & objAttachment.FileName
            objAttachment.SaveAsFile (strNewName)
        Next
    End If
End Sub

Open in new window

Outlookscripterrormessage.jpg
outlookscriptscreenshot.jpg
EmailMailboxTree.jpg
0
 
LVL 20

Accepted Solution

by:
ltlbearand3 earned 250 total points
ID: 39703823
It looks like your subfolders are not personal folders but part of your public folders.  Also, when you save the files off you only want one line of strNewName - the others overwrite the early.  Qlemo's code does a nice job of making this easy.  Try this code instead:

Private Sub Application_Startup()
	Dim mlItemsRegion1 as object
	Dim mlItemsRegion2 as object
	Dim mlItemsRegion3 as object
    
    ' Get the particular folders we want to watch
    ' Set up the item objects so that they trigger the Item Add Event
    Set mlItemsRegion1 = Outlook.Session.Folders("Mailbox - Stoots, Mike").Folders("Region1").Items
    Set mlItemsRegion2 = Outlook.Session.Folders("Mailbox - Stoots, Mike").Folders("Region2").Items
    Set mlItemsRegion3 = Outlook.Session.Folders("Mailbox - Stoots, Mike").Folders("Region3").Items
End Sub

Private Sub mlItemsRegion1_ItemAdd(ByVal Item As Object)
  Call SaveAttachment(Item, "Region1\")
End Sub

Private Sub mlItemsRegion2_ItemAdd(ByVal Item As Object)
  Call SaveAttachment(Item, "Region2\")
End Sub

Private Sub mlItemsRegion3_ItemAdd(ByVal Item As Object)
  Call SaveAttachment(Item, "Region3\")
End Sub

Private Sub SaveAttachment(Item As Object, subfolder As String)
    Dim objAttachment As Outlook.Attachment
    Dim strNewName As String
    
    ' Make sure we have a mail item before proceeding
    If Item.Class = Outlook.olMail Then
        ' Loop Through any attachments and save to network drive
        For Each objAttachment In Item.Attachments
            ' Create the new file name
            strNewName = "\\10.9.41.160\home_hlichrvaw3-ad1\mstoots\Completed Reports\EPO Reports\SQL EPOReportsLast24hrs Database portal\" & subfolder & objAttachment.FileName
            objAttachment.SaveAsFile (strNewName)
        Next
    End If
End Sub

Open in new window


-Bear
0
 
LVL 68

Assisted Solution

by:Qlemo
Qlemo earned 250 total points
ID: 39704187
It also looks like you might want to do something with the processed mails, like moving them into the respective subfolder of each region, so you can be sure the files have been processed. For many reasons automated processing can be suspended, and then needs to get re-enabled.

But doing that requires to have better folder names - "Region1" and "Region 1 Prossed Files" doesn't fit together that well. That should be either both "Region 1" or "Region1", but not mixed.
Anyway, if we assume the subfolder is the only one, insert this before line 37 in the code above:
       Item.Move Item.Parent.Folders(1)

Open in new window

to move the mail. Instead of that, you could add categories, or flag the mail, or mark as read, or whatever.
0
 

Author Comment

by:amstoots
ID: 39704685
I updated my script with what you suggested and did not get any error messages, but its not moving any of the attachments located in one of the 3 public folders. I not for sure if the script is running when close and reopen outlook client.... do I need to set up the script throw a rule for it to specified account. or do I need to wait for new mail to com in...  thanks for all of your help in advance...


Private Sub Application_Startup()
    Dim mlItemsRegion1 As Object
    Dim mlItemsRegion2 As Object
    Dim mlItemsRegion3 As Object
    
    ' Get the particular folders we want to watch
    ' Set up the item objects so that they trigger the Item Add Event
    Set mlItemsRegion1 = Outlook.Session.Folders("Mailbox - Stoots, Mike").Folders("Region1").Items
    Set mlItemsRegion2 = Outlook.Session.Folders("Mailbox - Stoots, Mike").Folders("Region2").Items
    Set mlItemsRegion3 = Outlook.Session.Folders("Mailbox - Stoots, Mike").Folders("Region3").Items
End Sub

Private Sub mlItemsRegion1_ItemAdd(ByVal item As Object)
  Call SaveAttachment(item, "Region1\")
End Sub

Private Sub mlItemsRegion2_ItemAdd(ByVal item As Object)
  Call SaveAttachment(item, "Region2\")
End Sub

Private Sub mlItemsRegion3_ItemAdd(ByVal item As Object)
  Call SaveAttachment(item, "Region3\")
End Sub

Private Sub SaveAttachment(item As Object, subfolder As String)
    Dim objAttachment As Outlook.Attachment
    Dim strNewName As String
    
    ' Make sure we have a mail item before proceeding
    If item.Class = Outlook.olMail Then
        ' Loop Through any attachments and save to network drive
        For Each objAttachment In item.Attachments
            ' Create the new file name
            strNewName = "\\10.9.41.160\home_hlichrvaw3-ad1\mstoots\Completed Reports\EPO Reports\SQL EPOReportsLast24hrs Database portal\" & subfolder & objAttachment.FileName
            objAttachment.SaveAsFile (strNewName)
            item.Move item.Parent.Folders(1)
        Next
    End If
End Sub

Open in new window

0
 
LVL 68

Expert Comment

by:Qlemo
ID: 39704853
Starting Outlook is sufficient to activate the code. But it only works for new mails. If you want to test, move mails out of the folder, and copy one back into it (moving does not always trigger the ItemAdd event). The attachment contained should be saved.
If you want to be sure whether the code is really executed, locate your cursor on a line within the SaveAttachment sub containing executive code (no DIM or Comment line), press F9, and then perform above test. Execution should halt at that line. Then press F9 again (to delete the breakpoint), and F5 to continue execution.
That is the basic method to start tests.
0
 

Author Closing Comment

by:amstoots
ID: 39713940
Sorry for getting back to you guys so late.. the script works great and moves the excel files w/o any problem...... thanks...
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Suggested Solutions

Utilizing an array to gracefully append to a list of EmailAddresses
Learn more about how the humble email signature can be used as more than just an electronic business card. When used correctly, a signature can easily be tailored for different purposes by different departments within an organization.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

708 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

16 Experts available now in Live!

Get 1:1 Help Now