I am trying to move an email after saving the attachment to a server folder. I added code (commented out) to try to move the email itself to another subfolder in my inbox. It is not working. Anyone see what I am missing?
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
'Only act if it's a MailItem
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
'location to save in. Can be root drive or mapped network drive.
Const attPath As String = "T:\Daily Report Raw Data"
Const attPath2 As String = "T:\Programmatic Deal Raw Data"
'Change variables to match need. Comment or delete any part unnecessary.
If (Msg.SenderEmailAddress = "[email protected]") And _
(Msg.Subject = "Last 7 Day House Ads") And _
(Msg.Attachments.Count >= 1) Then
Set myAttachments = item.Attachments
myAttachments.item(1).SaveAsFile attPath & "\Daily House Ads.xls"
'mark as read
Msg.UnRead = False
'Set olDestFldr = objNS.Folders("DFPHouse")
There is more code looking for other criteria, but this is the first step and the same code can be applied moving forward.