?
Solved

Adding a line of code to this macro that will move a mail message to another folder.

Posted on 2006-12-01
3
Medium Priority
?
313 Views
Last Modified: 2010-04-08
Blue Devil fan provided me with the following code which strips an attachment off of mail message and saves the attachment to a network folder.  It then places a hyperlink the saved file path in the original message body.  Works great.

I would like to see if one more piece of functionality to it.  After the attachment is stripped off and saved, I would like to move the remaining message out of the public folder and into another public folder.  The other folder is beneath this one.

So in other words say the Public folder where I run this macro is
\Public Folders\All Public Folders\MyFolder

I would like to move it to:
\Public Folders\All Public Folders\MyFolder\processed

Currently I am moving it manually but it would be great if just a line of additional code in the macro below could do it?

Thanks!

-----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
  • 2
3 Comments
 
LVL 76

Accepted Solution

by:
David Lee earned 2000 total points
ID: 18055498
Try this.

Sub SaveFolderAttachments()
    Dim olkMessage As Outlook.MailItem, _
        olkAttachment As Outlook.Attachment, _
        olkFolder As Outlook.MAPIFolder, _
        objFSO As Object, _
        myOrt As String, _
        myPath As String, _
        intIndex As Integer
    Set olkFolder = OpenMAPIFolder("\Public Folders\All Public Folders\MyFolder\processed")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    myOrt = "J:\Programming\"
    For intIndex = Application.ActiveExplorer.CurrentFolder.Items.Count To 1 Step -1
        Set olkMessage = Application.ActiveExplorer.CurrentFolder.Items.Item(intIndex)
        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
            olkMessage.Move olkFolder
        End If
    Next
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

'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: 18138331
Thanks.  I'll probably be back again some day on this topic.  I never got it to work quite right but have had to move on to other, pressing, items.  Thanks for the help.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18142827
Ok.  I'll be here when you're ready to pick it up.
0

Featured Post

Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

Question has a verified solution.

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

In this step by step procedure, you will come to know the details of creating an Outlook meeting in 2007, 2010, 2013 & 2016.
When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
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…
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Suggested Courses

752 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