Diane Poremsky
Senior Member
- OS Version(s)
- MacOS
- Windows
- iOS
- Android
- Outlook version
- Outlook 2016 32 bit
- Email Account
- Office 365 Exchange
As long as junk mail is going into the junk e-mail folder in the default data file, it should get picked up and moved.
Use this as the application_startup code - see if this brings up the dialog when Outlook starts (or when you click in the app start macro) - the message box may come up behind the splash screen - click on the taskbar icon to find it.
This is the full macro I'm using - it's the same as the one you posted, but without the annoying message box each time a message hits the junk folder. And it has the updated application startup.
Use this as the application_startup code - see if this brings up the dialog when Outlook starts (or when you click in the app start macro) - the message box may come up behind the splash screen - click on the taskbar icon to find it.
Code:
Private Sub Application_Startup()
Dim oFolder as Outlook.folder
Set oFolder = Session.GetDefaultFolder(olFolderJunk)
Set Items = oFolder.Items
MsgBox "Watching... " & oFolder.Name
End Sub
This is the full macro I'm using - it's the same as the one you posted, but without the annoying message box each time a message hits the junk folder. And it has the updated application startup.
Code:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim oFolder As Outlook.folder
Set oFolder = Session.GetDefaultFolder(olFolderJunk)
Set Items = oFolder.Items
MsgBox "Watching... " & oFolder.Name
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
' Set MovePst = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("xPort\Zunk")
Set MovePst = GetFolderPath("xPort\Zunk")
Item.UnRead = False
Item.Move MovePst
End Sub
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