Consulting

Results 1 to 4 of 4

Thread: Moving email from one folder to another on shared inbox

  1. #1

    Moving email from one folder to another on shared inbox

    Hi,

    In outlook I have my inbox, as well as a shared inbox. I have some vba code to export emails from the shared inbox to a windows folder. That part works great. However the last part of the macro then deletes these emails. The issue is the macro is deleting the emails in the shared inbox and putting them into my inbox's deleted items instead of the the shared inbox deleted items. Im wondering if anyone can help me...Current code is:

    ' Deletes messages in folder
    total_messages = objFolder.Items.Count
    For i = 1 To total_messages
    message_index = total_messages - i + 1
    Set oMessage = objFolder.Items.Item(message_index)
    oMessage.Delete
    Set oMessage = Nothing
    Next

    Thanks!

  2. #2
    Without access to your system it is difficult to be certain, but I think the following will work. The example below assumes that objFolder has been set to the shared inbox and with the Exit For line moves only one message.

    Set olDelFolder = objFolder.Parent.folders("Deleted Items")
        For i = objFolder.Items.Count To 1 Step -1
            objFolder.Items.Item(i).Move olDelFolder
            Exit For 'Delete this line after testing
        Next i
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Quote Originally Posted by gmayor View Post
    Without access to your system it is difficult to be certain, but I think the following will work. The example below assumes that objFolder has been set to the shared inbox and with the Exit For line moves only one message.

    Set olDelFolder = objFolder.Parent.folders("Deleted Items")
        For i = objFolder.Items.Count To 1 Step -1
            objFolder.Items.Item(i).Move olDelFolder
            Exit For 'Delete this line after testing
        Next i
    I get a run time error '-2147221233 (8004010f)': The attempted operation failed. An object could not be found for the first line. Any ideas? Here is the full macro:

    Sub emailbody()

    Dim myolApp As Outlook.Application
    Dim aItem As Object
    Set myolApp = CreateObject("Outlook.Application")
    Set mail = myolApp.ActiveExplorer.CurrentFolder
    Dim iItemsUpdated As Integer
    Dim strTemp As String
    Dim strFilenum As String
    iItemsUpdated = 0
    Dim xItem As Object
    Dim xNewSubject As String
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim path As String
    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.Folders.GetFirst ' folders of your current account
    Set objFolder = objNS.Folders("Request") ' this is the shared inbox
    Set objFolder = objFolder.Folders("Inbox")
    Debug.Print (objFolder.Name)
    Set objFolder = objFolder.Folders("Test2") ' subfolder.
    Debug.Print (objFolder.Name)


    For Each aItem In objFolder.Items

    Dim mattcombine, mattyear, mattmonth, mattday As String
    Dim i, j As Integer

    i = InStr(2, aItem.ReceivedTime, "/")
    j = InStr(i + 1, aItem.ReceivedTime, "/")

    ' MsgBox i & " and " & j

    mattyear = Mid(aItem.ReceivedTime, j + 1, 4)
    ' MsgBox mattyear

    mattmonth = Left(aItem.ReceivedTime, i - 1)
    If Len(mattmonth) = 1 Then
    mattmonth = "0" & mattmonth
    End If
    ' MsgBox mattmonth

    mattday = Mid(aItem.ReceivedTime, i + 1, j - i - 1)
    ' MsgBox mattday
    If Len(mattday) = 1 Then
    mattday = "0" & mattday
    End If

    ' MsgBox mattyear & "-" & mattmonth & "-" & mattday
    mattcombine = mattyear & "-" & mattmonth & "-" & mattday

    ' MsgBox mattcombine

    Dim zachcombine, zachhour, zachminute, zachsecond, zacho As String
    Dim z, q As Integer

    z = InStr(2, aItem.ReceivedTime, ":")
    q = InStr(z + 1, aItem.ReceivedTime, ":")

    ' MsgBox z & " and " & q

    zachhour = Mid(aItem.ReceivedTime, z - 2, 2)

    ' MsgBox zachhour

    Dim hourspace
    hourspace = Left(zachhour, 1)
    ' MsgBox hourspace

    If hourspace = " " Then
    zachhour = zachhour
    Else: zachhour = " " & zachhour
    End If

    ' MsgBox zachhour

    'Then
    ' zachhour = zachhour
    ' Else: zachhour = " " & zachhour
    'End If

    zachminute = Mid(aItem.ReceivedTime, z + 1, 2)
    ' MsgBox zachminute

    zachsecond = Mid(aItem.ReceivedTime, q + 1, 2)
    ' MsgBox zachsecond

    zacho = Mid(aItem.ReceivedTime, q + 4, 2)
    ' MsgBox zacho

    zachcombine = zachhour & "-" & zachminute & "-" & zachsecond & " " & zacho
    ' MsgBox zachcombine

    Dim zachpo As String
    Dim a, b As Integer

    a = InStr(aItem.Body, ",")
    b = InStr(a + 1, aItem.Body, ",")

    ' MsgBox a & " and " & b

    zachpo = Mid(aItem.Body, a + 1, b - a - 1)

    ' MsgBox zachpo

    ' Removes special characters
    Set xMailItem = aItem
    With xMailItem
    xNewSubject = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Rep lace(Replace(.Subject, "/", ""), ":", ""), ".", ""), "*", "") _
    , "|", ""), "", ""), "<", ""), ">", ""), "?", ""), ",", ""), Chr(34), "")
    .Subject = xNewSubject
    .Save
    End With

    ' Exports
    If TypeName(aItem) = "MailItem" Then
    ' ... do stuff here ...
    path = "C:\Users\XXXXXXXXX\Desktop\23" & aItem.Subject & " PO" & zachpo & " " & mattcombine & zachcombine & ".msg"
    aItem.SaveAs (path)
    'Debug.Print Item.ConversationTopic
    End If
    Next
    ' Deletes messages in folder
    Set olDelFolder = objFolder.Parent.Folders("Deleted Items")
    For i = objFolder.Items.Count To 1 Step -1
    objFolder.Items.Item(i).Move olDelFolder
    Exit For 'Delete this line after testing
    Next i
    End Sub

  4. #4
    Assuming that your code correctly identifies the location of objFolder as a subfolder of your shared inbox, then the code I posted cannot work as the parent folder of that sub folder is Inbox and that doesn't have a sub folder "Deleted Items". What you need then is to go up a level to the root folder e.g.
    Set olDelFolder = objFolder.Parent.Parent.Folders("Deleted Items")
    Don't forget to declare the olDelFolder at the top of the macro as an Outlook.MAPIFolder.
    Again without access to your system and how it is configured, it looks as though you have the shared inbox as a sub folder of your default account and not as a separate account, which is why the deleted items are going into the default deleted items folder, as indeed I suspect does this modification.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •