Move Mails from Inbox to Archive

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?

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

---

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

Code:

---

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

---

I was able to resolve this issue. Thank you!

Any chance of posting your solution then?

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.

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

Thank you for your welcome.

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