Macro 'compile error' - Sub or Function not defined

[patricknyc]

Hello,

I'm a bit lost. Getting a compile error "Sub or Function not defined" when running the macro below in Outlook 2010. GetFolderPath is being highlighted in yellow.

This macro is supposed to move emails >60 days old to a different PST folder. I have checked that the path names are correct and also tried moving it to a different folder, with the same result. Would greatly appreciate any help! Thanks!!

------ Macro below with item giving a compile error in bold----

Sub MoveAgedMail()


Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer

Set objOutlook = Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)

'Use a folder in a different data file
Set objDestFolder = GetFolderPath("Patricks\Archives inbox")

For intCount = objSourceFolder.Items.Count To 1 Step -1
Set objVariant = objSourceFolder.Items.Item(intCount)
DoEvents
If objVariant.Class = olMail Then

intDateDiff = DateDiff("d", objVariant.SentOn, Now)

' adjust number of days as needed.
If intDateDiff > 60 Then

objVariant.Move objDestFolder

'count the # of items moved
lngMovedItems = lngMovedItems + 1

End If
End If
Next

' Display the number of items that were moved.
MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub

[gmayor]

The macro is calling another Function called GetFolderPath. You appear not to have copied that function from wherever you obtained the macro.

[patricknyc]

Hi Graham/VBA Master. Thanks for helping a newbie. I found the GetFolderPath Function (see below) at slipstick.com and the macro now works like a charm. Appreciate the help!



Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer

On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function

GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function