Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Can firing this macro be automated?

Posted on 2006-11-15
8
Medium Priority
?
316 Views
Last Modified: 2010-04-08
Blue Devil Fan graciously provided me with the below macro code.

In a nutshell, when fired, it saves all of the attachments on all of the emails in  folder to a network drive.
It also saves them to a subfolder with this hieracrchy: Sender Name > Date Sent
It then strips the attachment from the email and drops a hyperlink in the message body pointed to the saved file on the network.

It works great.  Now I would like to know if it can be taken even one step further.  Can it run on it's own when a message is received.  I need to take some time off and need these attachments to continue to  be saved as they come in orf it will cause BIG problems for me.  I would MUCH rather have this automated then to rely on someone else doing it in my absence.

What are the options (any?).  Please note that the folder which receives these messages (the ones with attachments that need to be saved) is a PUBLIC FOLDER.

-----Begin macro code-------------------
Sub SaveFolderAttachments()
    Dim olkMessage As Outlook.MailItem, _
        olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        myOrt As String, _
        myPath As String
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    myOrt = "J:\Programming\"
    For Each olkMessage In Application.ActiveExplorer.CurrentFolder.Items
        myPath = myOrt & olkMessage.SenderName
        If Not objFSO.FolderExists(myPath) Then
            objFSO.CreateFolder (myPath)
        End If
        myPath = myPath & "\" & Format(olkMessage.SentOn,"MM-DD-YYYY")
       If Not objFSO.FolderExists(myPath) Then
            objFSO.CreateFolder (myPath)
        End If
        myPath = myPath & "\"
        If olkMessage.Attachments.Count > 0 Then
            olkMessage.HTMLBody = olkMessage.HTMLBody & "<br><br><b>Saved Attachments</b><br>"
            For Each olkAttachment In olkMessage.Attachments
                With olkAttachment
                    .SaveAsFile myPath & olkAttachment.FileName
                    olkMessage.HTMLBody = olkMessage.HTMLBody & "<a href=""file://" & myPath & olkAttachment.FileName & """>" & olkAttachment.FileName & "</a><br>"
                    .Delete
                End With
            Next
            olkMessage.Save
        End If
    Next
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

-----End macro code-------------------
0
Comment
Question by:snyperj
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
8 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 17952039
Greetings, snyperj.

Yes, this is possible, but perhaps not in the way you imagine.  It can process messages as they are received, but Outlook macros only run when Outlook is open and running.  If you are out of the office, then for this to work you'd have to leave your computer logged in and running the entire time for this to work.

Cheers!
0
 

Author Comment

by:snyperj
ID: 17952546
OK, so saying that I was able to leave my computer on - what would  need to do ti have the processing happen as each message is received.  Again, bearing in mind thtat this is a Public Folder we are talking about.


I know that through Folder Assistant, I can have a copy of the emails automatically forwarded from the Public Folder to my personal inbox even if my computer is not running.  So something, somewhere is monitoring the folder at all times in order to do that, right?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17965171
snyperj,

The simplest solution is to use the code below with an Outlook rule.  Set the rule fire on messages as they arrive.  Set the rule's action to run a script and choose this script.

Sub SaveFolderAttachments(Item As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        myOrt As String, _
        myPath As String
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    myOrt = "J:\Programming\"
    myPath = myOrt & Item.SenderName
    If Not objFSO.FolderExists(myPath) Then
        objFSO.CreateFolder (myPath)
    End If
    myPath = myPath & "\" & Format(Item.SentOn,"MM-DD-YYYY")
    If Not objFSO.FolderExists(myPath) Then
        objFSO.CreateFolder (myPath)
    End If
    myPath = myPath & "\"
    If Item.Attachments.Count > 0 Then
        Item.HTMLBody = Item.HTMLBody & "<br><br><b>Saved Attachments</b><br>"
        For Each olkAttachment In Item.Attachments
            With olkAttachment
                .SaveAsFile myPath & olkAttachment.FileName
                Item.HTMLBody = Item.HTMLBody & "<a href=""file://" & myPath & olkAttachment.FileName & """>" & olkAttachment.FileName & "</a><br>"
                .Delete
            End With
        Next
        Item.Save
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
End Sub
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

Author Comment

by:snyperj
ID: 17965503
Right- but how to do that on a Public Folder?  I thought you couldn't do rules on a Public Folder, only use the Folder Assistant and I don't see any options there to run script.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17998972
Sorry to be so slow getting back to you on this.  You're right, what I posted isn't going to work for a public folder.  I wasn't thinking about the public folder aspect when I made my previous post.  For a public folder we're going to need the following in addition to what I posted above.  

'This code goes in the ThisOutlookSession module.
Dim WithEvents olkFolder As Outlook.Items

Private Sub Application_Quit()
    Set olkFolder = Nothing
End Sub

Private Sub Application_Startup()
    'Change the public folder path on the following line
    Set olkFolder = OpenMAPIFolder("\Public Folders\All Public Folders\My Public Folder").Items
End Sub

Private Sub olkFolder_ItemAdd(ByVal Item As Object)
    If Item.Class = olMail Then
        SaveFolderAttachments Item
    End If
End Sub

'This code can go in any module
'Credit where credit is due.
'The code below is not mine.  I found it somewhere on the internet but do
'not remember where or who the author is.  The original author(s) deserves all
'the credit for these functions.
Function OpenMAPIFolder(szPath)
    Dim app, ns, flr, szDir, I
    Set flr = Nothing
    Set app = CreateObject("Outlook.Application")
    If Left(szPath, Len("\")) = "\" Then
        szPath = Mid(szPath, Len("\") + 1)
    Else
        Set flr = app.ActiveExplorer.CurrentFolder
    End If
    While szPath <> ""
        I = InStr(szPath, "\")
        If I Then
            szDir = Left(szPath, I - 1)
            szPath = Mid(szPath, I + Len("\"))
        Else
            szDir = szPath
            szPath = ""
        End If
        If IsNothing(flr) Then
            Set ns = app.GetNamespace("MAPI")
            Set flr = ns.Folders(szDir)
        Else
            Set flr = flr.Folders(szDir)
        End If
    Wend
    Set OpenMAPIFolder = flr
End Function

Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
0
 

Author Comment

by:snyperj
ID: 18048841
I copied everything to the modules as described.  However, I must not have something quite right.

When I open outlook I am getting:

Run-time error '-2147221233(8004010F)':
The operation failed.  An object could not be found.

>>when I click "debug" I am taken to the following line near the bottom of the Function OpenMapiFolder()

Set flr = flr.Folders(szDir)

What to do, what to do?
0
 
LVL 76

Accepted Solution

by:
David Lee earned 2000 total points
ID: 18050311
That error means that the public folder path has an error in it.  The routine that opens the folder isn't able to find one of the fodlers in the path.
0
 

Author Comment

by:snyperj
ID: 18054895
You were right of course.  I had forgotten the leading slash before Public Folders.  It works!  Thanks.

Followup question can be found here:
http://www.experts-exchange.com/Applications/MS_Office/Outlook/Q_22079327.html
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…

636 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