Errors when using excel vba to move outlook folders

[Joe Patrick]

Hello!

I get error 13/type mismatch on this line:

Set objFolder = objSourceFolder.Parent.Folders(AA_FOLDER).Folders(eventFolderTomove)

And a compile error method or data member not found on this line:

If Not (objFolder Is Nothing And objDestFolder Is Nothing) Then objFolder.MoveTo objDestFolder

Could someone please help me figure out how to fix? Thank you so much!

    Option Explicit
    Private Const olFolderInbox = 6


Private Sub archiveOutlookFolder()
    
    On Error GoTo errhandler


    Const AA_FOLDER As String = "Audits-Actuals"
    Const DEST_FOLDER As String = "PAST Audits-Actuals"


    Dim objOutlook As Object ' Outlook.Application
    Dim objNamespace As Object ' Outlook.Namespace
    Dim objSourceFolder As Object ' Outlook.MAPIFolder
    Dim objDestFolder As Object ' Outlook.MAPIFolder
    Dim objFolder As Folder ' Folder
    Dim AAfolderToMove As String
    Dim PNAToMove As String
    Dim eventFolderTomove As String
    Dim foundEventFolder As Boolean


    Dim olAAfolders As Object ' Outlook.Folder
    Dim olFolder As Object ' Outlook.Folder


    PNAToMove = ThisWorkbook.Sheets("data").Range("cleanpna").Value


    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    On Error GoTo errhandler
    If objOutlook Is Nothing Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
    


    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    Set olAAfolders = objSourceFolder.Parent.Folders(AA_FOLDER)


    foundEventFolder = False


    For Each olFolder In olAAfolders.Folders
        If InStr(olFolder.Name, PNAToMove) > 0 Then
            eventFolderTomove = olFolder.Name
            foundEventFolder = True
            Exit For
        End If
    Next olFolder


    If Not foundEventFolder Then
        MsgBox "I did not find an Outlook folder for this event to move to Past events. Please move manually.", vbCritical, "Audits\Actuals"
        Exit Sub
    End If


    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    Set objFolder = objSourceFolder.Parent.Folders(AA_FOLDER).Folders(eventFolderTomove)
    Set objDestFolder = objSourceFolder.Parent.Folders(DEST_FOLDER)


    If Not (objFolder Is Nothing And objDestFolder Is Nothing) Then objFolder.MoveTo objDestFolder


   Set objDestFolder = Nothing
   Set objFolder = Nothing
   Set objSourceFolder = Nothing
   Set objOutlook = Nothing
   Set objDestFolder = Nothing


   Exit Sub


errhandler:


    MsgBox Err.Number & vbLf & Err.Description




End Sub

 

[Jerry Sullivan]

Hi Joe, What's the relationship between the InBox folder and the folders "Audits-Actuals" and "PAST Audits-Actuals"?

If those two audit folders are within the InBox, then you need to remove the .Parent reference in three locations. Your current code appears to be based on the audit folders being at the same level hierarchy as the InBox.

 

[Joe Patrick]

Hi, Jerry, yes, that is correct (and the way I want/need it, lol), thanks.

Hi Joe, What's the relationship between the InBox folder and the folders "Audits-Actuals" and "PAST Audits-Actuals"?

If those two audit folders are within the InBox, then you need to remove the .Parent reference in three locations. Your current code appears to be based on the audit folders being at the same level hierarchy as the InBox.

 

[Joe Patrick]

I figured it out... the objFolder needed to be declared as an Object not a Folder... fixed both errors.