Problem with GetItemFromID

[m|sf|t]

All,
Below is some code that I am working on that adds the email address of the
selected items to our GFI blacklist. The code works perfect, except for
these lines:

Set objDel = objApp.Session.GetItemFromID(strEntryID)
objDel.Delete

which is where I am attempting to delete the item from the deleted items
folder.
I probably goobered it up a bunch, it's my first real attempt at an Outlook
addon.

Dim objApp As Outlook.Application
Dim objSelection As Selection
Dim objExplorer As Object
Dim objItem As Object
Dim objDel As Object

Dim db As Database
Dim strSQL As String
Dim strDomain As String
Dim strEmail As String
Dim strEntryID As String

Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Set objApp = CreateObject("Outlook.Application")

Msg = "Process these email(s) as SPAM ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Anti-Spam"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then

Set db = DBEngine.Workspaces(0).OpenDatabase("\\svr\c$\Program
Files\GFI\MailEssentials\config.mdb")

Dim oExp As Outlook.Explorer
Set oExp = Outlook.ActiveExplorer
Set objSelection = oExp.Selection

If objSelection.Count > 0 Then

For Each objItem In objSelection
If TypeOf objItem Is MailItem Then
strEmail = R_GetSenderAddress(objItem)
If Not (strEmail Like "*domain1.com") Or (strEmail Like
"*domain2.com") Then
strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('" & strEmail & "','1')"
db.Execute strSQL
strEntryID = objItem.entryID
objItem.Delete

Set objDel =
objApp.Session.GetItemFromID(strEntryID)
objDel.Delete

End If
End If
Next
End If

db.Close

End If

Set objApp = Nothing
Set objSelection = Nothing
Set objItem = Nothing

Thanks everyone.

 

[Michael Bauer]

Hi,

I don´t know which error you´re talking about (Err.Description, please).

Independent from that, if you like to delete or move an item from within
the loop then your For-Each doesn´t work.

Instead I´d recommend a While-Wend (handle objSelection(1) as long as
there are items in the collection):

While objSelection.Count
If Typeof objSelection(1) is Outlook.MailItem Then
...
Endif
Wend

Alternatively and often shown in samples you could use a backwards
For-Next:

For i=objSelection.Count To 1 Step -1
If Typeof objSelection(i) is Outlook.MailItem Then
...
Endif
Next

For this case (index based access to array elements) a little
performance test. For the absolute performance the hardware would be
relevant, not for the difference:

Deleting 20,000 collection elements:

1) While-Wend: 10 ms
2) For-Next: 16324 ms

 

[m|sf|t]

I don´t know which error you´re talking about (Err.Description, please).

Sorry, the Set objDel = objApp.Session.GetItemFromID(strEntryID) line gives
the error:
Run-time error '-2147221233 (8004010f)
The operation failed.
When I clicked Debug, I see that objDel=Empty and the strEntryID has the
correct ID

Alternatively and often shown in samples you could use a backwards
For-Next:

I redid the loop as you have suggested
For i = objSelection.Count To 1 Step -1
If TypeOf objSelection(i) Is Outlook.MailItem Then
strEmail = R_GetSenderAddress(objSelection(i))
If Not (strEmail Like "*domain1.com") Or (strEmail Like
"*domain2.com") Then
strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('" & strEmail & "','1')"
'db.Execute strSQL
strEntryID = objSelection(i).EntryID
objSelection(i).Delete
ERROR ---> Set objDel = objApp.Session.GetItemFromID(strEntryID)
objDel.Delete
End If
End If
Next

The first delete works just fine, but trying to remove it from the Deleted
Items isn't working.
Am I not DIMming something correctly ?

Thanks for taking time to help, this is so confusing.

 

[Wolfram Jahn]

All,
Below is some code that I am working on that adds the email address of the
selected items to our GFI blacklist. The code works perfect, except for
these lines:

Set objDel = objApp.Session.GetItemFromID(strEntryID)

Try to supply a storeID:

Set objDel = _
objApp.Session.GetItemFromID(strEntryID,objItem.parent.storeID)


There are some situations where this helps.

(But I'm sure Sue will have the real answer in one of the next replys...

Wolfram

 

[Michael Bauer]

Hi,

I don´t know why but deleting items via the OOM often causes problems.

You could try Wolfram´s suggestion. But AFAIK items are always deleted
into your default folder for deleted items, the StoreID shouldn´t be
neccessary in this case.

Maybe it works if you move the item into the Deleted Items folder first
and delete it then.

A reliable method for deleting items is the use of CDO instead of the
OOM.

 

[Michael Bauer]

Hi Wolfram,

thanks for your friendly comment...

 

[m|sf|t]

Thanks everyone for your help. I have tried several methods and still cannot
get it working. I am too new at this type of programming, I need to learn to
fundamentals before attempting to tackle a "production" application.

I am posting my code below in case any is interested in
helping/commenting/etc. Just for completeness, I would like to see how one
can delete a message permanetly and incorporate it into my code (for
learning). For now, I am going to crack Sue's book and start over =)

Thanks again everyone.
BTW, this code below uses Redemption.

CODE FROM CONNECT.DSR
Option Explicit
Dim WithEvents myControl As CommandBarButton

Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)

On Error Resume Next

Dim oExp As Outlook.Explorer
Dim oBar As Office.CommandBar

Set oExp = Outlook.ActiveExplorer
Set oBar = oExp.CommandBars.Item("Standard")

Set myControl = oBar.FindControl(, , "Spam")

If myControl Is Nothing Then
Set myControl = oBar.Controls.Add(, , , 11, True)
With myControl
.Caption = "Spam"
.FaceId = 1019
.Style = msoButtonIconAndCaption
.Tag = "Spam"
.Visible = True
End With
End If

End Sub

Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)

On Error Resume Next

End Sub

Private Sub myControl_Click(ByVal Ctrl As _
Office.CommandBarButton, CancelDefault As Boolean)
Call basUnsolicited
End Sub

CODE FROM MODULE
Function R_GetSenderAddress(objMsg)
Dim strType
Dim objSenderAE
Dim objSMail
Const PR_SENDER_ADDRTYPE = &HC1E001E
Const PR_EMAIL = &H39FE001E

Set objSMail = CreateObject("Redemption.SafeMailItem")

objSMail.Item = objMsg
strType = objSMail.Fields(PR_SENDER_ADDRTYPE)

Set objSenderAE = objSMail.Sender
If Not objSenderAE Is Nothing Then
If strType = "SMTP" Then
R_GetSenderAddress = objSenderAE.Address
ElseIf strType = "EX" Then
R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)
End If
End If

Set objSenderAE = Nothing
Set objSMail = Nothing

End Function

Sub basUnsolicited()
Dim objSelection As Selection
Dim objExplorer As Object
Dim objItem As Object
Dim objDel

Dim db As Database
Dim strSQL As String
Dim strDomain As String
Dim strEmail As String
Dim strEntryID, strParentID As String

Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Msg = "Process these email(s) as SPAM ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Anti-Spam"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then

Set db = DBEngine.Workspaces(0).OpenDatabase("\\server\c$\Program
Files\GFI\MailEssentials\config.mdb")

Dim oExp As Outlook.Explorer
Set oExp = Outlook.ActiveExplorer
Set objSelection = oExp.Selection

If objSelection.Count > 0 Then

For i = objSelection.Count To 1 Step -1
If TypeOf objSelection(i) Is Outlook.MailItem Then
strEmail = R_GetSenderAddress(objSelection(i))
If Not (strEmail Like "*domain1.com") Or (strEmail Like
"*domain2.com") Then
strSQL = "INSERT INTO antispam2_blacklist
(entry,type) VALUES ('" & strEmail & "','1')"
db.Execute strSQL
strEntryID = objSelection(i).EntryID
strParentID = objSelection(i).Parent.StoreID
objSelection(i).Delete
End If
End If
Next
End If

db.Close

End If

Set objApp = Nothing
Set objSelection = Nothing
Set objItem = Nothing
End Sub

 

[Wolfram Jahn]

I need to learn to fundamentals

Good idea! ;-)

Just for completeness, I would like to see how one
can delete a message permanetly and incorporate it into my code (for
learning).

This code below deletes messages from my inbox; I put it into a module
and call it by hand (e.g. ->del_msg "Best"<- )
which deletes all mail messages from my inbox which start with the
string "Best"; as you can see, I added the complication of storing IDs
just to show that getItemFromID is working.

'---

Public Sub del_msg(subjectPart)
Dim ibx As MAPIFolder, msg, i, arr, itm As MailItem, mId, oNs As NameSpace

msg = ""
Set oNs = Application.GetNamespace("MAPI")
Set ibx = oNs.GetDefaultFolder(olFolderInbox)
For i = ibx.Items.Count To 1 Step -1
If ibx.Items(i).MessageClass = "IPM.Note" Then
If InStr(1, ibx.Items(i).Subject, subjectPart) = 1 Then
msg = msg & " " & ibx.Items(i).EntryID
End If
End If
Next i
If msg <> "" Then
arr = Split(msg)
For Each mId In arr
Set itm = oNs.GetItemFromID(mId)
itm.Delete
Next mId
End If
End Sub

'---

Wolfram

 

[m|sf|t]

This code below deletes messages from my inbox; I put it into a module and

call it by hand (e.g. ->del_msg "Best"<- )
which deletes all mail messages from my inbox which start with the string
"Best"; as you can see, I added the complication of storing IDs just to
show that getItemFromID is working.

Thanks again for your help. I was able to modify my code and incorporate
yours, and it deletes the items without any problem,
however, they are still in the deleted items. Does your code, on your end,
delete the item from the Inbox and the Deleted Items ? or is my code still
boogered up ?

 

[Wolfram Jahn]

ok, this one deletes at once without any question,
################
so be careful!!!
################
You will need a reference to the Microsoft CDO 1.2 Library.

---

Public Sub del_msg(subjectPart)
Dim ibx As MAPIFolder, msg, i, arr, itm As MailItem, mId, oNs As
NameSpace, sep
Dim ses As MAPI.Session
Dim mbx As MAPI.Folder
Dim mms As MAPI.Message

Set ses = CreateObject("MAPI.Session")
ses.Logon
Set mbx = ses.Inbox

msg = ""
sep = ""
Set oNs = Application.GetNamespace("MAPI")
Set ibx = oNs.GetDefaultFolder(olFolderInbox)
For i = ibx.Items.Count To 1 Step -1
If ibx.Items(i).MessageClass = "IPM.Note" Then
If InStr(1, ibx.Items(i).Subject, subjectPart) = 1 Then
msg = msg & sep & ibx.Items(i).EntryID
sep = " "
End If
End If
Next i
If msg <> "" Then
arr = Split(msg)
For Each mId In arr
Set mms = ses.GetMessage(mId, mbx.StoreID)
mms.Delete
Next mId
End If
End Sub