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

Outlook VBA, moving completed to Archive

Posted on 2009-04-07
6
1,780 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
  • 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
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
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

VMware Disaster Recovery and Data Protection

In this expert guide, you’ll learn about the components of a Modern Data Center. You will use cases for the value-added capabilities of Veeam®, including combining backup and replication for VMware disaster recovery and using replication for data center migration.

Question has a verified solution.

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

This process describes the steps required to Import and Export data from and to .pst files using Exchange 2010. We can use these steps to export data from a user to a .pst file, import data back to the same or a different user, or even import data t…
Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
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…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

860 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