Move Mails from Inbox to Archive

[rolling_zep]

Hi All,

This is a requirement of an existing code. The below code works and saves the attachment and also marks the read mails as Processed.

But I need to move these Processed mails from the Inbox to the folder, Archive_Proc. I am trying to Set the folder, objDestfolder as the destination folder for these processed mails to be moved. But I am getting object not found error (bolded line).
How to fix the code?

    Dim olApp As Object
    Dim MYFOLDER As Object
    Dim OlItems As Object
    Dim olMail As Object
    Dim x As Integer
    Dim subject As String
    Dim strFile As String
    Dim strFolderpath As String
    Dim objDestfolder As Object
    Dim mychar As Object
    Dim sreplace As String



Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
    Set olApp = CreateObject("Outlook.Application")
End If


strFolderpath = "C:\Users\Testing"
'On Error Resume Next


' Set the Attachment folder.
strFolderpath = strFolderpath & "\Attachments\"


    Set MYFOLDER = olApp.GetNamespace("MAPI").Folders("WeeklyProceedings Mailbox").Folders("Inbox")

    Set OlItems = MYFOLDER.Items


    For Each olMail In OlItems
        If olMail.subject Like "*Proceeding ID*" Then
            strFile = olMail & ".XML"
            strFile = strFolderpath & strFile
            If olMail.Attachments.Count > 0 Then
                For x = 1 To olMail.Attachments.Count
                    olMail.Attachments.Item(x).SaveAsFile strFile
                Next x
                
                subject = olMail.subject
                sreplace = "_"
                subject = Replace(subject, " ", sreplace)
                olMail.Body = olMail.Body & vbCrLf & "The file was processed " & Now()
                olMail.subject = "Processed - " & subject
                'olMail.Move objDestfolder
                olMail.Save


            End If
        End If


    Next


    Set objDestfolder = olApp.GetNamespace("MAPI").Folders("WeeklyProceedings Mailbox").Folders("Archive_Proc")
    olMail.Move objDestfolder

    
Set MYFOLDER = Nothing
Set OlMail = Nothing
Set OlItems = Nothing
Set olApp = Nothing
Srt objDestfolder = Nothing

[Aussiebear]

After a quick search on the net, it was suggested that this could work. I've not tried it so no guarantees:

Sub MoveDraftMail()
 Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objItem As Variant
Dim Archive_Folder As Outlook.MAPIFolder
Set objOutlook = New Outlook.Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.Folders(10).Folders("Name of Folder")
Set Archive_Folder = objNamespace.Folders("Online Archive - My@email").Folders("Personal_Folders").Folders("2021").Folders("InBox")
For Each objItem In objSourceFolder.Items
    If TypeName(objItem) = "MailItem" Then
    objItem.Move Archive_Folder
    End If
Next objItem
Set objDestFolder = Nothing
End Sub

[rolling_zep]

I was able to resolve this issue. Thank you!

[Aussiebear]

Any chance of posting your solution then?

[meghankn]

Oh, yes Aussiebear, your code, it worked. I tried and it moved my email from the "Name of Folder" within the 10th account's mailbox to the "2021\Inbox" folder within an online archive associated with the my email address.

[Aussiebear]

Welcome to VBAX meghankn. Thank you for testing the code.

[meghankn]

Thank you for your welcome.

[namdosan1409]

Use the app object to extract all attachments for a specific sender. Filter the messages with attachments and add all the attachment ids and their corresponding message ids to a list/dict .

car games