Outlook.Items of mail items are empty

R

Reiner

Hi,

I try to write a macro that deletes double (and more) emails. Take a
look on the code (you can input a folder structure with up to three
folders).

----------------------------------------------------------------
Sub DoppelteLoeschen()

Dim olNameSpace As NameSpace
Dim olInputBox As MAPIFolder
Dim olFolderInbox As MAPIFolder
Dim olFolderSent As MAPIFolder
Dim InboxItems As Outlook.MailItem
Dim ItemSearch As Outlook.MailItem
Dim ItemFound As Outlook.MailItem
Dim ItemsToSearch As Outlook.Items
Dim ItemsRestricted As Outlook.Items
Dim bDoNext As Boolean
Dim intMails As Integer, i As Integer, j As Integer
Dim szMajorFolder, szText, szTitle, szDefault, szFolder As String,
szSubFolder As String
Dim deInDate1 As Date, deSendDate1 As Date, szSenderName1 As String,
szSubject1 As String
Dim deInDate2 As Date, deSendDate2 As Date, szSenderName2 As String,
szSubject2 As String
On Error Resume Next
Set olNameSpace = Application.GetNamespace("MAPI")
szMajorFolder = "Reiner"
szTitle = "Ordnerbestimmung"
szDefault = "Reiner"
szText = "Bitte geben Sie den Namen des Hauptordners unter
<Persönliche Ordner> ein."
szMajorFolder = InputBox(szText, szTitle, szDefault)
If Len(szMajorFolder) = 0 Then
szMajorFolder = "Reiner"
End If

szDefault = ""
szText = "Bitte geben Sie den Namen des zu bearbeitenden Ordners
unter " + szMajorFolder + " ein."
szFolder = InputBox(szText, szTitle, szDefault)
If szFolder = "ENDE" Then
i = MsgBox("Makro ohne Aktion beendet", vbOKOnly, "Makro
beendet")
Exit Sub
End If

If Len(szFolder) > 0 Then
szDefault = ""
szText = "Bitte geben Sie den Namen des zu bearbeitenden Ordners
unter " + szMajorFolder + " und " + szFolder + " ein."
szSubFolder = InputBox(szText, szTitle, szDefault)
If szSubFolder = "ENDE" Then
i = MsgBox("Makro ohne Aktion beendet", vbOKOnly, "Makro
beendet")
Exit Sub
End If
End If

If szMajorFolder = "Posteingang" Then
Set olInputBox = olNameSpace.GetDefaultFolder(olFolderInbox)
ElseIf szMajorFolder = "Gesendete Objekte" Then
Set olInputBox = olNameSpace.GetDefaultFolder(olFolderSent)
ElseIf Len(szFolder) = 0 Then
Set olInputBox =
Application.GetNamespace("MAPI").Folders("Persönliche
Ordner").Folders(szMajorFolder)
ElseIf Len(szSubFolder) = 0 Then
Set olInputBox =
Application.GetNamespace("MAPI").Folders("Persönliche
Ordner").Folders(szMajorFolder).Folders(szFolder)
Else
Set olInputBox =
Application.GetNamespace("MAPI").Folders("Persönliche
Ordner").Folders(szMajorFolder).Folders(szFolder).Folders(szSubFolder)
End If
'olInputBox.Items.Sort "[SentOn]" + "[Subject]" + "[SenderName]",
True
olInputBox.Items.Sort "[SentOn]", False

Dim sFilter As String
iCount = olInputBox.Items.Count
Dim sNothing As String
sNothing = "Nothing"
Set ItemsToSearch = olInputBox.Items
For Each ItemSearch In olInputBox.Items
With ItemSearch
deInDate1 = .ReceivedTime
deSendDate1 = .SentOn
szSenderName1 = .SenderName
szSubject1 = .Subject
' sFilter = "[ReceivedTime] = '" & Format(.ReceivedTime,
"yyyymmddhhmmss") & "' And [SentOn] = '" _
' & Format(.SentOn, "yyyymmddhhmmss") & "' And
[SenderName] = '" & .SenderName _
' & "' And [Subject] = '" & .Subject & "'"
' No seconds allowed?
sFilter = "[ReceivedTime] = '" & Format(.ReceivedTime,
"yyyymmddhhmm") & "' And [SentOn] = '" _
& Format(.SentOn, "yyyymmddhhmm") & "' And
[SenderName] = '" & .SenderName _
& "' And [Subject] = '" & .Subject & "'"
sFilter = "[Subject] = 'Projektangebote ID Netz'"
End With
'ItemFound = olInputBox.Items.Find(sFilter)
ItemFound = ItemsToSearch.Find(sFilter)
ItemsRestricted = olInputBox.Items.Restrict(sFilter)
While TypeName(ItemFound) <> sNothing
If ItemFound.EntryID <> ItemSearch.EntryID Then
ItemFound.Delete
End If
'ItemFound = olInputBox.Items.FindNext
ItemFound = ItemsToSearch.FindNext
Wend
Next ItemSearch

End Sub
----------------------------------------------------------------
The problem is that the items of olInputBox (seen at the Watcher) are
all empty. In "Item X" you can read "<No Variables>". But ItemSearch is
not empty.

Does anybody knows what's wrong with my code?


Asking greetings

Reiner
 
M

Michael Bauer

Am 17 Oct 2005 09:26:21 -0700 schrieb Reiner:

Hallo Reiner,

do you have any reason not to use the PickFolder function? With it you could
save the first half of the code :)

Your questions at the bottom I don´t really understand. Despite of I´ve a
few tips for you.

1. Because you want to delete items from within a loop you must run the loop
backwards. Exp.:
For i=Items.Count to 1 Step -1

There´re two loops for the same collection of items, so both loops have to
run backwards.

2. Because the mail folder can contain other object types than MailItems
only you should test the object type before using the MailItem variable.
Exp.:
Dim obj as Object
Dim oMail as Outlook.MailItem
For i=
Set obj=Items(i)
If TypeOf obj is Outlook.MailItem Then
Set oMail=obj

3. In the With ItemSearch block you´re building two filter criteria, and the
second overwrites the first one.

4. I´d use Restrict instead of Find and loop through it backwards if the
result contains items.

And please let me add my 2 cents: Short, clean code extremly increases your
chance that anybody takes the time to go through it.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
Hi,

I try to write a macro that deletes double (and more) emails. Take a
look on the code (you can input a folder structure with up to three
folders).

----------------------------------------------------------------
Sub DoppelteLoeschen()

Dim olNameSpace As NameSpace
Dim olInputBox As MAPIFolder
Dim olFolderInbox As MAPIFolder
Dim olFolderSent As MAPIFolder
Dim InboxItems As Outlook.MailItem
Dim ItemSearch As Outlook.MailItem
Dim ItemFound As Outlook.MailItem
Dim ItemsToSearch As Outlook.Items
Dim ItemsRestricted As Outlook.Items
Dim bDoNext As Boolean
Dim intMails As Integer, i As Integer, j As Integer
Dim szMajorFolder, szText, szTitle, szDefault, szFolder As String,
szSubFolder As String
Dim deInDate1 As Date, deSendDate1 As Date, szSenderName1 As String,
szSubject1 As String
Dim deInDate2 As Date, deSendDate2 As Date, szSenderName2 As String,
szSubject2 As String
On Error Resume Next
Set olNameSpace = Application.GetNamespace("MAPI")
szMajorFolder = "Reiner"
szTitle = "Ordnerbestimmung"
szDefault = "Reiner"
szText = "Bitte geben Sie den Namen des Hauptordners unter
<Persönliche Ordner> ein."
szMajorFolder = InputBox(szText, szTitle, szDefault)
If Len(szMajorFolder) = 0 Then
szMajorFolder = "Reiner"
End If

szDefault = ""
szText = "Bitte geben Sie den Namen des zu bearbeitenden Ordners
unter " + szMajorFolder + " ein."
szFolder = InputBox(szText, szTitle, szDefault)
If szFolder = "ENDE" Then
i = MsgBox("Makro ohne Aktion beendet", vbOKOnly, "Makro
beendet")
Exit Sub
End If

If Len(szFolder) > 0 Then
szDefault = ""
szText = "Bitte geben Sie den Namen des zu bearbeitenden Ordners
unter " + szMajorFolder + " und " + szFolder + " ein."
szSubFolder = InputBox(szText, szTitle, szDefault)
If szSubFolder = "ENDE" Then
i = MsgBox("Makro ohne Aktion beendet", vbOKOnly, "Makro
beendet")
Exit Sub
End If
End If

If szMajorFolder = "Posteingang" Then
Set olInputBox = olNameSpace.GetDefaultFolder(olFolderInbox)
ElseIf szMajorFolder = "Gesendete Objekte" Then
Set olInputBox = olNameSpace.GetDefaultFolder(olFolderSent)
ElseIf Len(szFolder) = 0 Then
Set olInputBox =
Application.GetNamespace("MAPI").Folders("Persönliche
Ordner").Folders(szMajorFolder)
ElseIf Len(szSubFolder) = 0 Then
Set olInputBox =
Application.GetNamespace("MAPI").Folders("Persönliche
Ordner").Folders(szMajorFolder).Folders(szFolder)
Else
Set olInputBox =
Application.GetNamespace("MAPI").Folders("Persönliche
Ordner").Folders(szMajorFolder).Folders(szFolder).Folders(szSubFolder)
End If
'olInputBox.Items.Sort "[SentOn]" + "[Subject]" + "[SenderName]",
True
olInputBox.Items.Sort "[SentOn]", False

Dim sFilter As String
iCount = olInputBox.Items.Count
Dim sNothing As String
sNothing = "Nothing"
Set ItemsToSearch = olInputBox.Items
For Each ItemSearch In olInputBox.Items
With ItemSearch
deInDate1 = .ReceivedTime
deSendDate1 = .SentOn
szSenderName1 = .SenderName
szSubject1 = .Subject
' sFilter = "[ReceivedTime] = '" & Format(.ReceivedTime,
"yyyymmddhhmmss") & "' And [SentOn] = '" _
' & Format(.SentOn, "yyyymmddhhmmss") & "' And
[SenderName] = '" & .SenderName _
' & "' And [Subject] = '" & .Subject & "'"
' No seconds allowed?
sFilter = "[ReceivedTime] = '" & Format(.ReceivedTime,
"yyyymmddhhmm") & "' And [SentOn] = '" _
& Format(.SentOn, "yyyymmddhhmm") & "' And
[SenderName] = '" & .SenderName _
& "' And [Subject] = '" & .Subject & "'"
sFilter = "[Subject] = 'Projektangebote ID Netz'"
End With
'ItemFound = olInputBox.Items.Find(sFilter)
ItemFound = ItemsToSearch.Find(sFilter)
ItemsRestricted = olInputBox.Items.Restrict(sFilter)
While TypeName(ItemFound) <> sNothing
If ItemFound.EntryID <> ItemSearch.EntryID Then
ItemFound.Delete
End If
'ItemFound = olInputBox.Items.FindNext
ItemFound = ItemsToSearch.FindNext
Wend
Next ItemSearch

End Sub
----------------------------------------------------------------
The problem is that the items of olInputBox (seen at the Watcher) are
all empty. In "Item X" you can read "<No Variables>". But ItemSearch is
not empty.

Does anybody knows what's wrong with my code?


Asking greetings

Reiner
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Outlook programmierung 2

Top