Solved

Outlook VBA, moving completed to Archive

Posted on 2009-04-07
6
1,801 Views
Last Modified: 2012-08-14
Im trying to write some code, to scan through my inbox folders, and anything I have ticked to be completed, move into my archive folder.

Problem is, I cant seem to get it past the line:-
Set myInputFolder = myInbox.Folders(GetFolder(Mid(srcFolder, InStr(Mid(srcFolder, 3), "\") + 3)))

Which should just be saying what folder its scanning, in the first case 'Inbox'.

Any ideas?


Sub ArchiveCompleted()
    SearchFolder GetFolder("Mailbox\Inbox"), "Archive 2009"
End Sub
 
Sub SearchFolder(olkFolder As Outlook.MAPIFolder, destPST As String)
    Dim olkSubfolder As Outlook.MAPIFolder
 
    For Each olkSubfolder In olkFolder.Folders
        SearchFolder olkSubfolder, destPST
        MoveItems olkFolder.FolderPath, destPST & Mid(olkSubfolder.FolderPath, InStr(3, olkSubfolder.FolderPath, "\"))
    Next
    Set olkSubfolder = Nothing
End Sub
 
 
 
Sub MoveItems(srcFolder As String, desFolder As String)
 
    Dim myolAPP As New Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myInbox As Outlook.MAPIFolder
    Dim myInputFolder As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
    Dim myItem As Outlook.MailItem
    Dim Item As Outlook.MailItem
    
    Set myNameSpace = myolAPP.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
       
    'MsgBox Mid(srcFolder, InStr(Mid(srcFolder, 3), "\") + 3)
    'Set myInputFolder = myInbox.Folder
    
    Set myInputFolder = myInbox.Folders(Mid(srcFolder, InStr(Mid(srcFolder, 3), "\") + 3))
    
    
    
    Set myDestFolder = GetFolder(desFolder)
    Set myItems = myInputFolder.Items
    
    While myItems.Count > 0
        For Each Item In myItems
            If Not IsNull(Item.FlagRequest) Then
                Item.Move myDestFolder
            End If
        Next
        Set myItems = myInputFolder.Items
    Wend
 
End Sub
 
 
 
 
Public Function GetFolder(strFolderPath As String) As MAPIFolder
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim colFolders As Outlook.Folders
    Dim objFolder As Outlook.MAPIFolder
    Dim arrFolders() As String
    Dim I As Long
    On Error Resume Next
    
    strFolderPath = Replace(strFolderPath, "/", "\")
    arrFolders() = Split(strFolderPath, "\")
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = objNS.Folders.Item(arrFolders(0))
    If Not objFolder Is Nothing Then
        For I = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(I))
            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If
    
    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing
    Set objApp = Nothing
End Function

Open in new window

0
Comment
Question by:tonelm54
[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
  • 2
  • 2
6 Comments
 

Author Comment

by:tonelm54
ID: 24085970
..
0
 
LVL 28

Expert Comment

by:peakpeak
ID: 24086320
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 24092027
Hi, tonelm54.

Some of that code looks like something I might have written at some point.  Here's a simpler approach to what you've said you want to accomplish.  This code searches through the inbox and all folders below it for items marked as complete.  Complete in this case means that the item has been flagged as complete.  All items so marked are moved to the archive folder.  Follow these instructions to use this.

1.  Start Outlook
2.  Click Tools > Macro > Visual Basic Editor
3.  If not already expanded, expand Microsoft Office Outlook Objects
4.  If not already expanded, expand Modules
5.  Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
6.  Copy the code from the Code Snippet box and paste it into the right-hand pane of Outlook's VB Editor window
7.  Edit the code as needed.  I included comments wherever something needs to or can change
8.  Click the diskette icon on the toolbar to save the changes
9.  Close the VB Editor

Run the macro ArchiveCompleted.

Private olkArchiveFolder As Outlook.MAPIFolder
 
Sub ArchiveCompleted()
    'Change the folder path on the next line to that of your archive file and the folder you want the items to be filed in'
    Set olkArchiveFolder = OpenOutlookFolder("Personal Folders\Completed Items)
    ProcessFolder Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
End Sub
 
Sub ProcessFolder(olkFolder As Outlook.MAPIFolder)
    Dim olkSubfolder As Outlook.MAPIFolder, olkItem As Object, intCount As Integer
    For intCount = olkFolder.Items.Count To 1 Step -1
        Set olkItem = olkFolder.Items.Item(intCount)
        If olkItem.FlagStatus = olFlagComplete Then
            olkItem.Move olkArchiveFolder
        End If
    Next
    For Each olkSubfolder In olkFolder.Folders
        ProcessFolder olkSubfolder
    Next
    Set olkSubfolder = Nothing
End Sub
 
Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
 
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        olkFolder As Outlook.MAPIFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = Session.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function

Open in new window

0
What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

 
LVL 28

Expert Comment

by:peakpeak
ID: 24092053
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24092102
That could arguably be said about any bit of code.  
0
 

Author Comment

by:tonelm54
ID: 24094977
The code works great, apart from when it sees reports, Ive raised another question for this, as it is a new question Q_24304821
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

What does UTC stand for?  “Coordinated Universal Time” – Think of this as the true time on Planet Earth that never changes with the exception of minor leap seconds here and there to account for the changes in the planet's rotation.   What does th…
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
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 …
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

738 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