Move Emails between Folders in Separate Mailbox

Status
Not open for further replies.
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Greetings,

I am trying to move all messages in one subfolder to another. Actually I have to do that twice but I can adapt the code myself. My trouble is that I'm far more adept with Access VBA than Outlook VBA. Also, the message folders (current and target) aren't within my own mailbox, they're within another in my profile (not even sure if I'm using the right terminology). I've included a snapshot of the mailbox layout below. So within the TDEM Contracts mailbox(?), I need a way to move all messages from Daily Emails to "daily_log_holding_area". Once I manipulate it and run the reports I need to, I then need to move them from there to "logged_emails". Certainly I could just click and drag but with 100's - 1,000's needing to move each day I'm forced to move them in multiple chucks, which just takes to much attention/time/steps. I'm able to find similar code to what I need, but I can't seem to adapt it to the fact that it's not my own inbox. It may just be a syntax thing I'm unfamiliar with.

Any help would be greatly appreciated!
David


mailbox_snapshot.PNG
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
they're within another in my profile (not even sure if I'm using the right terminology).
Based on the screenshot, it looks like it is a shared mailbox (the display name instead of an email address)
You'll use the method at Working with VBA and non-default Outlook Folders

This is the inbox:
Set InboxFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
reference the subfolder of inbox:
Set subFolder = InboxFolder.folder("folder name")
 
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Based on the screenshot, it looks like it is a shared mailbox (the display name instead of an email address)
You'll use the method at Working with VBA and non-default Outlook Folders

This is the inbox:
Set InboxFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
reference the subfolder of inbox:
Set subFolder = InboxFolder.folder("folder name")
Thanks Diane! A quick followup question. Though it's not in the screenshot, I have multiple shared mailboxes that I can access. Will the code you've provided be able to determine the right one or will additional code be necessary? Thanks!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Thanks Diane! A quick followup question. Though it's not in the screenshot, I have multiple shared mailboxes that I can access. Will the code you've provided be able to determine the right one or will additional code be necessary? Thanks!
You'll need to repeat the code. Depending on how the macro is written, you'll either use different object names and basically repeat the code below, or loop and use a different recipient name each time. This would work with an array or select case (and cut down on the amount of code you need to use.)

You could use a small macro that sets the mailbox name (and even the folder names to use), then call one that does the move.

Code:
 Set objOwner = NS.CreateRecipient("maryc")
    objOwner.Resolve
      
If objOwner.Resolved Then
   'MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
 
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
You'll need to repeat the code. Depending on how the macro is written, you'll either use different object names and basically repeat the code below, or loop and use a different recipient name each time. This would work with an array or select case (and cut down on the amount of code you need to use.)

You could use a small macro that sets the mailbox name (and even the folder names to use), then call one that does the move.

Code:
 Set objOwner = NS.CreateRecipient("maryc")
    objOwner.Resolve
    
If objOwner.Resolved Then
   'MsgBox objOwner.Name
Set newCalFolder = NS.GetSharedDefaultFolder(objOwner, olFolderCalendar)
End If
Well, I've made some great progress but somewhere I'm screwing up. I have the following code, though the couple of examples you sent had some slightly different naming conventions so my inexperience may be at fault if I've incorrectly pieced them together. Every time I run this code:
Code:
Sub MoveMail()

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim strDestFolder As String
    Dim inboxSourceFolder As Outlook.MAPIFolder
    Dim DestsubFolder As Outlook.MAPIFolder
    Dim SourcesubFolder As Outlook.MAPIFolder
      
    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("tdem")
    Set inboxSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    Set SourcesubFolder = inboxSourceFolder.Folder("Daily Emails")
    Set DestsubFolder = inboxSourceFolder.Folder("daily_log_holding_area")
  
    For intCount = SourcesubFolder.Items.Count To 1 Step -1
        Set objVariant = SourcesubFolder.Items.Item(intCount)
        DoEvents
 
              objVariant.Move DestsubFolder
            
              'count the # of items moved
               lngMovedItems = lngMovedItems + 1

    Next
  
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
It gives me the most unhelpful error message "Sorry, something went wrong. You may want to try again." When I hit debug it points me to the row that begins "Set objNamespace". For background, I deviated from your example a bit because I want all the emails in a folder moved, regardless of their characteristic. I should also point out that "TDEM" is the alias used for the account. The email prefix before the @ is "tdem.contract", I've tried both and gotten the same error message, I wasn't sure which to use.

Thanks SO much. This has been very helpful for me and I greatly appreciate your feedback and assistance.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
i have not tested this yet - but i think i fixed all the errors - i need to figure out which test account is shared with another before i can test it. :)

The folder tree in the shared box will be
-Inbox
-- Daily Emails
-- daily_log_holding_area



Code:
Sub MoveMail()

    Dim objOutlook As Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim strDestFolder As String
    Dim inboxSourceFolder As Outlook.MAPIFolder
    Dim DestsubFolder As Outlook.MAPIFolder
    Dim SourcesubFolder As Outlook.MAPIFolder
     
    Set objOutlook = Application
    Set NS = objOutlook.GetNamespace("MAPI")
   
'### Get Shared
    Set objOwner = NS.CreateRecipient("maryc")
    objOwner.Resolve
     
If objOwner.Resolved Then
   'MsgBox objOwner.Name
Set inboxSourceFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

'### end get shared

    Set SourcesubFolder = inboxSourceFolder.Folders("Daily Emails")
    Set DestsubFolder = inboxSourceFolder.Folders("daily_log_holding_area")
 
    For intCount = SourcesubFolder.Items.Count To 1 Step -1
        Set objVariant = SourcesubFolder.Items.Item(intCount)
        DoEvents
              objVariant.Move DestsubFolder
           
              'count the # of items moved
               lngMovedItems = lngMovedItems + 1

    Next
 
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
 
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
i have not tested this yet - but i think i fixed all the errors - i need to figure out which test account is shared with another before i can test it. :)

The folder tree in the shared box will be
-Inbox
-- Daily Emails
-- daily_log_holding_area



Code:
Sub MoveMail()

    Dim objOutlook As Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim strDestFolder As String
    Dim inboxSourceFolder As Outlook.MAPIFolder
    Dim DestsubFolder As Outlook.MAPIFolder
    Dim SourcesubFolder As Outlook.MAPIFolder
    
    Set objOutlook = Application
    Set NS = objOutlook.GetNamespace("MAPI")
  
'### Get Shared
    Set objOwner = NS.CreateRecipient("maryc")
    objOwner.Resolve
    
If objOwner.Resolved Then
   'MsgBox objOwner.Name
Set inboxSourceFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

'### end get shared

    Set SourcesubFolder = inboxSourceFolder.Folders("Daily Emails")
    Set DestsubFolder = inboxSourceFolder.Folders("daily_log_holding_area")
 
    For intCount = SourcesubFolder.Items.Count To 1 Step -1
        Set objVariant = SourcesubFolder.Items.Item(intCount)
        DoEvents
              objVariant.Move DestsubFolder
          
              'count the # of items moved
               lngMovedItems = lngMovedItems + 1

    Next
 
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
Thank you so much. The folder tree is exactly right. When I tested the code, it threw "Object Variable or With block variables not set" and directed me to the "Set SourcesubFolder" line. Thank you again so much for all your help!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
i'm getting a different error on that line - object cant be found (I just created the folder but that shouldn't make a difference)

ETA: opened the mailbox in another profile and the folders i added didn't sync up. that explains my error.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Ok.. once i got the folder issues solved, this worked to move mail from Daily Emails to the log holding folder.

move-mail.png


Code:
Sub MoveMail()

    Dim objOutlook As Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim strDestFolder As String
    Dim inboxSourceFolder As Outlook.MAPIFolder
    Dim destSubFolder As Outlook.MAPIFolder
    Dim sourceSubFolder As Outlook.MAPIFolder
     
    Set objOutlook = Application
    Set NS = objOutlook.GetNamespace("MAPI")
   
'### Get Shared
    Set objOwner = NS.CreateRecipient("replies")
    objOwner.Resolve
     
If objOwner.Resolved Then
   MsgBox objOwner.Name
Set inboxSourceFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
   MsgBox inboxSourceFolder.FolderPath

End If

'### end get shared

  Set destSubFolder = inboxSourceFolder.Folders("daily_log_holding_area")
  Set sourceSubFolder = inboxSourceFolder.Folders("Daily Emails")
 
    For intCount = sourceSubFolder.Items.Count To 1 Step -1
        Set objVariant = sourceSubFolder.Items.Item(intCount)
        DoEvents
              objVariant.Move destSubFolder
           
              'count the # of items moved
               lngMovedItems = lngMovedItems + 1

    Next
 
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
 
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Hey Diane,

I must be doing something else wrong because I'm still getting that error message that you're not. I've attached two pictures that show what's going on. One is the error message and the other is what going into debug shows. Thank you again so much for your help!

pic1.PNG
pic2.PNG


Thanks!
 
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
Ok.. once i got the folder issues solved, this worked to move mail from Daily Emails to the log holding folder.

View attachment 2152

Code:
Sub MoveMail()

    Dim objOutlook As Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim strDestFolder As String
    Dim inboxSourceFolder As Outlook.MAPIFolder
    Dim destSubFolder As Outlook.MAPIFolder
    Dim sourceSubFolder As Outlook.MAPIFolder
    
    Set objOutlook = Application
    Set NS = objOutlook.GetNamespace("MAPI")
  
'### Get Shared
    Set objOwner = NS.CreateRecipient("replies")
    objOwner.Resolve
    
If objOwner.Resolved Then
   MsgBox objOwner.Name
Set inboxSourceFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
   MsgBox inboxSourceFolder.FolderPath

End If

'### end get shared

  Set destSubFolder = inboxSourceFolder.Folders("daily_log_holding_area")
  Set sourceSubFolder = inboxSourceFolder.Folders("Daily Emails")
 
    For intCount = sourceSubFolder.Items.Count To 1 Step -1
        Set objVariant = sourceSubFolder.Items.Item(intCount)
        DoEvents
              objVariant.Move destSubFolder
          
              'count the # of items moved
               lngMovedItems = lngMovedItems + 1

    Next
 
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub

Not sure if this is my issue but I have multiple shared mailboxes. How does the code direct to a specific mailbox. I see it get the folders of course, but not the inbox. Again, I've an early novice with Outlook so maybe it does. Thanks!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Does that folder exist? if you hover of the yellow words, what does it show?

This is where it directs the shared box:
Set objOwner = NS.CreateRecipient("replies")

This is one way to handle running it on multiple folders. The alias can be the alias, the display name, or the email address.


Code:
Dim strAlias As String

Sub MoveMail()
strAlias = "replies"
DoMoveMail
strAlias = "olSales"
DoMoveMail
End Sub


Sub DoMoveMail()

    Dim objOutlook As Outlook.Application
    Dim NS As Outlook.NameSpace
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim strDestFolder As String
    Dim inboxSourceFolder As Outlook.MAPIFolder
    Dim destSubFolder As Outlook.MAPIFolder
    Dim sourceSubFolder As Outlook.MAPIFolder
     
    Set objOutlook = Application
    Set NS = objOutlook.GetNamespace("MAPI")
   
'### Get Shared
    Set objOwner = NS.CreateRecipient(strAlias)
    objOwner.Resolve
     
If objOwner.Resolved Then
   MsgBox objOwner.Name
Set inboxSourceFolder = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)
   MsgBox inboxSourceFolder.FolderPath

End If

'### end get shared

  Set destSubFolder = inboxSourceFolder.Folders("daily_log_holding_area")
  Set sourceSubFolder = inboxSourceFolder.Folders("Daily Emails")
 
    For intCount = sourceSubFolder.Items.Count To 1 Step -1
        Set objVariant = sourceSubFolder.Items.Item(intCount)
        DoEvents
              objVariant.Move destSubFolder
           
              'count the # of items moved
               lngMovedItems = lngMovedItems + 1

    Next
 
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
Set objDestFolder = Nothing
End Sub
 
Status
Not open for further replies.
Top