Code to move Msg in Outlook

[Pugs320]

I have several Modules set up to extract Email attachments to a file. The code is like this:

Public Function getmailZip1()
Dim myOlApp As Object
Dim myNamespace As Object
Dim MyFolder As Object
Dim myItem As Object
Dim myAttachments As Object

Set myOlApp = CreateObject("Outlook.Application&quot
Set myNamespace = myOlApp.GetNamespace("MAPI&quot
Set MyFolder = myNamespace.GetDefaultFolder(olFolderInbox)

Set myItem = MyFolder.Items("Zip1&quot
'myItem.Display

Set myAttachments = myItem.Attachments
myAttachments.Item(1).SaveAsFile "j:\Folder\SubFolder\" & myAttachments.Item(1).DisplayName


End Function

I get several downloads daily from an outside agency as zip files which I must export to a folder, unzip, and rename. I finally got this to work but now I need to get these messages out of my inbox and into deleted items folder with code. These downloads also arrive on weekends so I need to automate this for the weekend. Why do I need to do this because the downloads come with the same name for attachments every day. Any Ideas? I am using Access 97.

 

[Page410]

Have you tried: myItem.Delete

That should delete the mail note, effectively sending it to the Deleted Items folder.

Following is some code to remove files from you Deleted Items folder base on their subjuct and Sent date. This could easily be removed if you just want to remove all. This is Access 2000/Outlook but you should be able to get it to fly for 97 with some tweaks.

Function EmptyDeletedItems()
Dim myOlApp As Outlook.Application, olNameSpace As NameSpace, DeletedItems As MAPIFolder, mailCounter As Integer
Dim AllMessages As Items, message As Object, filterString As String, strSubject As String

Set myOlApp = CreateObject("Outlook.Application&quot
Set olNameSpace = myOlApp.GetNamespace("MAPI&quot
Set DeletedItems = olNameSpace.GetDefaultFolder(olFolderDeletedItems)

' Get all of the messages in the Inbox
Set AllMessages = DeletedItems.Items
filterString = "[SentOn] > '" & Date - 3 & "'"
Set message = AllMessages.Find(filterString)

For mailCounter = 1 To DeletedItems.Items.count
strSubject = Left(message.Subject, 14)
If strSubject = "LEADS NewLeave" Then
message.Delete
Set message = Nothing
Set message = AllMessages.FindNext
End If
Next mailCounter

Set DeletedItems = Nothing
Set olNameSpace = Nothing

MsgBox "Complete"

End Function

 

[Pugs320]

Thanks for the response Page410. I tried your code and nothing was deleted from my Inbox. Here is what I did

Public Function DelMailTest()
Dim myOlApp As Outlook.Application, olNameSpace As NameSpace, Inbox As mapiFolder, mailCounter As Integer
Dim AllMessages As Items, message As Object, MyFolder As Object, filterString As String, strSubject As String

Set myOlApp = CreateObject("Outlook.Application&quot
Set olNameSpace = myOlApp.GetNamespace("MAPI&quot
Set Inbox = olNameSpace.GetDefaultFolder(olFolderInbox)
Set MyFolder = olNameSpace.GetDefaultFolder(olFolderDeletedItems)

' Get all of the messages in the Inbox
Set AllMessages = Inbox.Items
filterString = "[SentOn] >'" & Date - 3 & "'"
Set message = AllMessages.Find(filterString)

For mailCounter = 1 To Inbox.Items.Count
strSubject = Left(message.Subject, 14)
If strSubject = "test" Then
message.Delete
Set message = Nothing
Set message = AllMessages.FindNext
End If
Next mailCounter


MsgBox "Complete"

End Function

What I did was send myself an email with 'test' in the subject line. The code cycled through but the email wasn't deleted. What am I not seeing? I am thinking it may have something to do with the filterString = "[SentOn] >'" & Date - 3 & "'" code but I am not familiar with this syntax. Still learning!!

 

[Pugs320]

I have tried a few things with different code suggestions. The code I have now I am able to step through it OK but there doesn't seem to be any result.

Function DelMailInbox()
Dim myOlApp As Outlook.Application, olNameSpace As NameSpace, Inbox As mapiFolder, mailCounter As Integer
Dim AllMessages As Items, message As Object, filterString As String, strSubject As String

Set myOlApp = CreateObject("Outlook.Application&quot
Set olNameSpace = myOlApp.GetNamespace("MAPI&quot
Set Inbox = olNameSpace.GetDefaultFolder(olFolderInbox)

' Get all of the messages in the Inbox
Set AllMessages = Inbox.Items
filterString = "[Subject] > " & "test" & ""
Set message = AllMessages.Find(filterString)


If filterString = "test" Then
message.Delete
Set message = Nothing
Set message = AllMessages.FindNext
End If


Set Inbox = Nothing
Set olNameSpace = Nothing


End Function

I have sent myself an email with "test" in the subject line but this code does not remove it from my Inbox. If I am going about this wrong can someone please point me in the right direction? There are a total of 10 emails I would like to remove from my inbox on a daily basis including weekends. Each email has a different subject.
Thank you for your help.


Andy