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
Solved

Can firing this macro be automated?

Posted on 2006-11-15
8
311 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
  • 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
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 

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 500 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

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

If you don't know how to downgrade, my instructions below should be helpful.
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
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…

808 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