Wondering if anyone might be able to help with this one.
I have a process that will be required to get mail from 3 different shared outlook mailboxes.
The emails are in a sub folder of the inbox and getting them works perfectly fine, however when it comes to moving them to another sub folder to ensure they are not read again and again the action fails.
I am not sure why it would work fine to read the mails from each of the mailbox sub folders but then not be able to move them.
The action does appear to work fine to move emails from the default profile but not the others - I don't have a choice in the use of the 3 separate shared mail accounts so really need to find out a way to fix this.
If anyone is able to help it would be greatly appreciated
This is the error I get however there are no errors in the object
This is the code that doesn't work
Dim app = CreateObject("Outlook.Application")
Dim _nameSpace = app.GetNameSpace("MAPI")
Dim olSharedRecip as object
if Profile <> "" then
_nameSpace.Logon(Profile, , True, True)
end if
'Dim folder = _nameSpace.GetDefaultFolder(RootFolderID)
Dim folder as object
if sharedEmail <> Nothing then
olSharedRecip = _nameSpace.CreateRecipient(sharedEmail)
folder = _nameSpace.GetSharedDefaultFolder(olSharedRecip, RootFolderID)
else
folder = _nameSpace.GetDefaultFolder(RootFolderID)
end if
Dim item = _nameSpace.GetItemFromID(ID)
If moveTo <> "" Then
folder = folder.Folders(moveTo)
End If
New_Entry_ID = item.Move(folder).EntryIDAnd the code that does work
Dim app = CreateObject("Outlook.Application")
Dim _nameSpace = app.GetNameSpace("MAPI")
Dim folder = _nameSpace.GetDefaultFolder(Outlook_Folder_ID)
Dim olSharedRecip as object
if Profile <> "" then
_nameSpace.Logon(Profile, , True, True)
end if
if sharedEmail <> Nothing then
olSharedRecip = _nameSpace.CreateRecipient(sharedEmail)
folder = _nameSpace.GetSharedDefaultFolder(olSharedRecip, Outlook_Folder_ID)
end if
If Sub_Folder <> "" Then
For each name as string in Sub_Folder.Split("\")
folder = folder.Folders(name)
Next
End If
'See https://msdn.microsoft.com/en-us/library/office/aa210946(v=office.11).aspx
'for mail item properties
Dim dataTable As New Data.DataTable
dataTable.Columns.Add("EntryID", Type.GetType("System.String"))
dataTable.Columns.Add("To", Type.GetType("System.String"))
dataTable.Columns.Add("CC", Type.GetType("System.String"))
dataTable.Columns.Add("Subject", Type.GetType("System.String"))
dataTable.Columns.Add("Body", Type.GetType("System.String"))
dataTable.Columns.Add("Attachments", Type.GetType("System.String"))
dataTable.Columns.Add("ReceivedOn", Type.GetType("System.DateTime"))
dataTable.Columns.Add("SentOn", Type.GetType("System.DateTime"))
dataTable.Columns.Add("SenderName", Type.GetType("System.String"))
dataTable.Columns.Add("SenderEmailAddress", Type.GetType("System.String"))
dataTable.Columns.Add("Unread", Type.GetType("System.Boolean"))
Dim i = 1
'Due to the filter string, this is stored as a dynamic COM object. Any modification to a mail item (IE mark read, move, delete) will cause the array length to change and will break the for each.
Requeue:
Dim folderItems = If(Filter_Expression <> "", folder.Items.Restrict(Filter_Expression), folder.Items)
if Oldest then
folderItems.Sort("[SentOn]",False)
else
folderItems.Sort("[SentOn]",True)
end if
For Each item As Object In folderItems
If Not TypeOf item Is MailItem Then Continue For
Dim row As Data.DataRow = dataTable.NewRow
row("EntryID") = item.EntryID
row("To") = item.To
row("CC") = item.CC
row("Subject") = item.Subject
if HTML = True
row("Body") = item.HTMLBody
else
row("Body") = item.Body
end if
if MarkRead = True then
item.UnRead=0
end if
Dim attachments As String = ""
For Each attachment As Object In item.Attachments
If attachment.Type = 1 Then
attachments = attachments & "|" & attachment.DisplayName
End If
Next
row("Attachments") = If (attachments.Length = 0, "", attachments.SubString(1))
row("SentOn") = item.SentOn
row("ReceivedOn") = item.ReceivedTime
row("SenderName") = item.SenderName
row("SenderEmailAddress") = If (item.SenderEmailType = "EX",item.Sender.GetExchangeUser.PrimarySmtpAddress,item.SenderEmailAddress)
row("Unread") = item.Unread
dataTable.Rows.Add(row)
Item_Count += 1
dim New_Entry_ID = "foobar"
if moveTo <> "" then
if Delete <> True then
Dim MoveTarget = folder.Folders.item(moveTo)
New_Entry_ID=item.Move(MoveTarget).EntryID
end if
end if
'If the ID has changed, pass that to the collection instead, so we know how to find it. The original ID will have been invalidated, anyway.
if New_Entry_ID <> "foobar" then
row("EntryID") = New_Entry_ID
end if
if Delete = True then
item.Delete()
end if
i = i+1
if MaxCount > 0 and i >= MaxCount
exit for
end if
if MarkRead or Delete or moveTo <>"" then
goto Requeue
end if
Next
Items = dataTable------------------------------
James Gregory
RPA Developer
Europe/London
------------------------------
Hello James,
I tried to recreate the above-mentioned folder structure and move the mails in the shared mailbox after reading.
VBO Used: Microsoft Outlook Email VBO v10.3.1
Inbox Folder Structure:
Move Email Action:
------------------------------
Athiban Mahamathi - https://www.linkedin.com/in/athiban-mahamathi-544a008b/
Technical Consultant,
SimplifyNext,
Singapore
------------------------------
