B
Barney Mowder
All-
NOTE: my code is posted at the BOTTOM of this message.
I'm using Outlook 2000 VBA on a Exchange 5.5 client mailbox, and I
have a situation where I am responsible for another special account
which receives mail.
I have full permissions in this special account's mailbox, and can
manually move items around from the Outlook GUI with no trouble. It
is open i my outlook sessions as a matter of course.
For reasons too complex to explain, I need to programmatically
change the subject of selected items in the special account's inbox,
and move them to a sub folder in the special account's inbox via a
macro.
The problem I'm having is that I can get a path to the sub folder,
but when I use the .Move method on a mail item, it doesn't actually
move. No error is reported, and the subject setting method works
fine. I have tried both:
objItem.Move objFolder
and
set objItem = objItem.Move(objFolder)
but they both do not work, and they both return no run-time error.
Can anyone help me with this beast? I'm running out of hair to pull
out.
Thanks, Barney.
The code I'm using is :
Sub SetSubjSID()
On Error Resume Next
Dim objApp As Application
Dim objFolder As Object
Dim objSel As Selection
Dim objItem As Object
Dim wString As String
Dim iIdx0 As Integer
Dim objNameSpace As Object
Dim objRecipient As Recipient
Dim objSafeMail As Object
Set objSafeMail = CreateObject("Redemption.SafeMailItem")
Set objApp = GetObject(, "Outlook.Application")
Set objNameSpace = objApp.GetNamespace("MAPI")
Set objRecipient = objNameSpace.CreateRecipient("SPECIAL_ACCOUNT")
Set objFolder = objNameSpace.GetSharedDefaultFolder(objRecipient,
olFolderInbox).folders("ReSubject")
Set objSel = objApp.ActiveExplorer.Selection
For Each objItem In objSel
DoEvents
If bAbort = True Then
GoTo EndSub
End If
If (objItem.Class = olReportItem) Then
wString = GetRecip(objItem)
objItem.Subject = wString
objItem.Save
ElseIf (objItem.Class = olMailItem) Then
If (objItem.Attachments.Count) Then
wString = ""
Dim Recip
Dim objOlItem As Object
Set objOlItem = CreateObject("Redemption.SafeMailItem")
objOlItem.Item = objItem
For iIdx0 = 1 To objOlItem.Item.Attachments.Count
Dim objReItem As Object
Set objReItem = CreateObject("Redemption.SafeMailItem")
objReItem.Item =
objOlItem.Attachments.Item(iIdx0).EmbeddedMsg
If (objReItem.Item.Class = olMailItem) Then
If (objReItem.SenderName = "SPECIAL_ACCOUNT") Then
For Each Recip In objReItem.Recipients
wString = Recip.Name
Next Recip
End If
End If
Set objReItem = Nothing
Next iIdx0
If (wString <> "") Then
objItem.Subject = wString
objItem.Save
Set objItem = objItem.Move(objFolder)
DoEvents
End If
Set Recip = Nothing
Set objOlItem = Nothing
End If
End If
Next
EndSub:
bAbort = False
Set objNameSpace = Nothing
Set objRecipient = Nothing
Set objItem = Nothing
Set objSel = Nothing
Set objFolder = Nothing
Set objApp = Nothing
End Sub
NOTE: my code is posted at the BOTTOM of this message.
I'm using Outlook 2000 VBA on a Exchange 5.5 client mailbox, and I
have a situation where I am responsible for another special account
which receives mail.
I have full permissions in this special account's mailbox, and can
manually move items around from the Outlook GUI with no trouble. It
is open i my outlook sessions as a matter of course.
For reasons too complex to explain, I need to programmatically
change the subject of selected items in the special account's inbox,
and move them to a sub folder in the special account's inbox via a
macro.
The problem I'm having is that I can get a path to the sub folder,
but when I use the .Move method on a mail item, it doesn't actually
move. No error is reported, and the subject setting method works
fine. I have tried both:
objItem.Move objFolder
and
set objItem = objItem.Move(objFolder)
but they both do not work, and they both return no run-time error.
Can anyone help me with this beast? I'm running out of hair to pull
out.
Thanks, Barney.
The code I'm using is :
Sub SetSubjSID()
On Error Resume Next
Dim objApp As Application
Dim objFolder As Object
Dim objSel As Selection
Dim objItem As Object
Dim wString As String
Dim iIdx0 As Integer
Dim objNameSpace As Object
Dim objRecipient As Recipient
Dim objSafeMail As Object
Set objSafeMail = CreateObject("Redemption.SafeMailItem")
Set objApp = GetObject(, "Outlook.Application")
Set objNameSpace = objApp.GetNamespace("MAPI")
Set objRecipient = objNameSpace.CreateRecipient("SPECIAL_ACCOUNT")
Set objFolder = objNameSpace.GetSharedDefaultFolder(objRecipient,
olFolderInbox).folders("ReSubject")
Set objSel = objApp.ActiveExplorer.Selection
For Each objItem In objSel
DoEvents
If bAbort = True Then
GoTo EndSub
End If
If (objItem.Class = olReportItem) Then
wString = GetRecip(objItem)
objItem.Subject = wString
objItem.Save
ElseIf (objItem.Class = olMailItem) Then
If (objItem.Attachments.Count) Then
wString = ""
Dim Recip
Dim objOlItem As Object
Set objOlItem = CreateObject("Redemption.SafeMailItem")
objOlItem.Item = objItem
For iIdx0 = 1 To objOlItem.Item.Attachments.Count
Dim objReItem As Object
Set objReItem = CreateObject("Redemption.SafeMailItem")
objReItem.Item =
objOlItem.Attachments.Item(iIdx0).EmbeddedMsg
If (objReItem.Item.Class = olMailItem) Then
If (objReItem.SenderName = "SPECIAL_ACCOUNT") Then
For Each Recip In objReItem.Recipients
wString = Recip.Name
Next Recip
End If
End If
Set objReItem = Nothing
Next iIdx0
If (wString <> "") Then
objItem.Subject = wString
objItem.Save
Set objItem = objItem.Move(objFolder)
DoEvents
End If
Set Recip = Nothing
Set objOlItem = Nothing
End If
End If
Next
EndSub:
bAbort = False
Set objNameSpace = Nothing
Set objRecipient = Nothing
Set objItem = Nothing
Set objSel = Nothing
Set objFolder = Nothing
Set objApp = Nothing
End Sub