I get no errors, when I use the redemption code the message is sent but itemsend code isn't initiated.
If I comment out the redemption code the itemsend is initiated once the message is sent.
here is my code.
Set FS = CreateObject("Scripting.FileSystemObject")
Set myattachments = Nothing
Set ol = Nothing
Set NewMail = Nothing
Set SafeItem = Nothing
Set ol = New Outlook.Application
Set NewMail = New Redemption.SafeMailItem
Set SafeItem = ol.CreateItem(olMailItem)
NewMail.Item = SafeItem
With NewMail
.SentOnBehalfOfName = "US CBG Reporting"
.to = mailname$
.Importance = olImportanceHigh
.Subject = Subject$
.Body = Body$ & Chr(13) & Chr(13)
.Recipients.ResolveAll
End With
If attach$ = "" Then
Set myattachments = Nothing
Else:
Set myattachments = NewMail.Attachments
Do
TEMP_ATTACH$ = attach$
IntPos = InStr(1, attach$, ",")
If IntPos > 0 Then
attach1$ = (Left(attach$, IntPos - 1))
Set F_Attach1 = FS.GetFile(attach1$)
mysize = F_Attach1.Size
If mysize > 3000000 Then
myattachments.Add attach1$, olByReference
Else:
myattachments.Add attach1$
End If
attach$ = Right(attach$, Len(attach$) - IntPos)
Else
Set F_Attach1 = FS.GetFile(attach$)
mysize = F_Attach1.Size
If mysize > 3000000 Then
myattachments.Add attach$, olByReference
Else:
myattachments.Add attach$
End If
End If
Loop Until InStr(1, TEMP_ATTACH$, ",") = 0
End If
NewMail.Send
Set Utils = CreateObject("Redemption.MAPIUtils")
Utils.Cleanup
End Function
Here is my itemsend code.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
previousday = Date - 1 + Time
Set ol = New Outlook.Application
Set pgmoutlook = ol.GetNamespace("MAPI")
Set myinbox = pgmoutlook.GetDefaultFolder(olFolderInbox)
Set mymailbox = pgmoutlook.Folders(2)
Set cbgmailbox = pgmoutlook.Folders(3)
' Move items sent from US CBG Rep in my inbox to the US CBG Rep deleted folder
Set cbgdeleted = cbgmailbox.Folders("Deleted Items")
Set myinboxitems = myinbox.Items
Set myinboxitem = myinboxitems.Find("[Sendername] = 'US CBG REPORTING'")
While TypeName(myinboxitem) <> "Nothing"
myinboxitem.Move cbgdeleted
Set myinboxitem = myinboxitems.FindNext
Wend
' moves items sent from us cbg rep in my sent folder to the us cbg rep sent folder
'Set mysent = mynamespace.GetDefaultFolder(olFolderSentMail)
Set mysent = mymailbox.Folders("Sent Items")
Set cbgsent = cbgmailbox.Folders("Sent Items")
Set mysentitems = mysent.Items
Set mysentitem = mysentitems.Find("[Sendername] = 'US CBG REPORTING'")
While TypeName(mysentitem) <> "Nothing"
mysentitem.Move cbgsent
Set mysentitem = mysentitems.FindNext
Wend
'moves items sent from us cbg rep in my deleted folder to the US CBG rep deleted folder
Set mydeleted = mymailbox.Folders("Deleted Items")
Set cbgdeleted = cbgmailbox.Folders("Deleted Items")
Set mydeleteditems = mydeleted.Items
Set mydeleteditem = mydeleteditems.Find("[Sendername] = 'US CBG REPORTING'")
While TypeName(mydeleteditem) <> "Nothing"
mydeleteditem.Move cbgdeleted
Set mydeleteditem = mydeleteditems.FindNext
Wend
'moves items sent from us cbg rep in its sent folder to the US CBG rep deleted folder
Set cbgsentitems = cbgsent.Items
Set cbgsentitem = cbgsentitems.Find("[Sendername] = 'US CBG REPORTING'")
While TypeName(cbgsentitem) <> "Nothing"
sentdate$ = cbgsentitem.SentOn
If sentdate$ < previousday Then
cbgsentitem.Move cbgdeleted
Set cbgsentitem = cbgsentitems.FindNext
Else:
Set cbgsentitem = cbgsentitems.FindNext
End If
Wend
'deletes out of office messages from US CBG Rep inbox
Set cbginbox = cbgmailbox.Folders("Inbox")
Set cbginboxitems = cbginbox.Items
Set cbginboxitem = cbginboxitems.Find("[Sendername] <> 'US CBG Reporting'")
While TypeName(cbginboxitem) <> "Nothing"
Subject$ = cbginboxitem.Subject
If Left$(Subject$, 13) = "Out of office" Or Left$(Subject$, 13) = "Out of Office" Then
cbginboxitem.Move cbgdeleted
Set cbginboxitem = cbginboxitems.FindNext
Else:
Set cbginboxitem = cbginboxitems.FindNext
End If
Wend
'deletes items in US CBG rep deleted folder older than 1 day
Set cbgdeleteditems = cbgdeleted.Items
Set cbgdeleteditem = cbgdeleteditems.GetFirst
While TypeName(cbgdeleteditem) <> "Nothing"
sentdate$ = cbgdeleteditem.SentOn
If sentdate$ < previousday Then
cbgdeleteditem.Delete
Set cbgdeleteditem = cbgdeleteditems.GetNext
Else:
Set cbgdeleteditem = cbgdeleteditems.GetNext
End If
Wend
End Sub
----- Dmitry Streblechenko wrote: -----
Are you getting any errors? Does Item_Send start working once you comment
out the Redempton code? What is your Redemption code?
Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
Kevin W said:
I have code that runs from Excel, Access, that sends out reports
automatically. Now that I have xp I have modified my code to use Redemption
so that my workstations can be locked and still run the reports. The problem
is I also have code in the thisoutlooksession module (application_itemsend)
that no longer works. The emails are sent out and I can see them in my sent
folder but my itemsend code isn't moving the messages or doing other things
that the code is suppose to do. Any suggestions on why the itemsend isn't
working when I use redemption?
