Moving Sent Items To Another ARCHIVE Sent Folder.

I had this code which work pretty well from this user here.
https://www.mrexcel.com/forum/excel-...-folder-4.html

But need someone to help on add-on.
Possible to move send email to ARCHIVE Folder once email sent on outlook?

ARCHIVE Folder: 2019_ARCHIVE
Subfolder: SendFolder

Code:

---


Sub SendEmail()
    Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, d As Long
    Dim wks As Worksheet, pf As String, wPath As String, wFile As Variant, wPattern As String
    Dim num_err As Variant, sErr As Boolean


    'START of confirmation message box'
    response = MsgBox("Start sending email?", vbYesNo)
    If response = vbNo Then
        MsgBox ("Macro Canceled!")
        Exit Sub
    End If
    'END of confirmation message box'
   
    Set Mail_Object = CreateObject("Outlook.Application")
    Set wks = Worksheets("SendEmail")
    lr = wks.Cells(Rows.Count, "B").End(xlUp).Row
    For i = 2 To lr
        sErr = False
        With Mail_Object.CreateItem(o)
            .to = wks.Range("B" & i).Value
            .cc = wks.Range("C" & i).Value
            .Subject = wks.Range("D" & i).Value
            .Body = wks.Range("E" & i).Value & vbNewLine & _
                wks.Range("F" & i).Value & vbNewLine & _
                wks.Range("G" & i).Value
           
            pf = wks.Range("H" & i).Value
            d = InStrRev(pf, "\")
            wPath = Left(pf, d)
            wPattern = Mid(pf, d + 1)
            If wPath <> "" Then
                If wPattern = "" Then wPattern = "*.*"
                'If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
                If Dir(wPath, vbDirectory) <> "" Then
                    wFile = Dir(wPath & wPattern)
                    On Error Resume Next
                    If wFile <> "" Then
                        Do While wFile <> ""
                            .Attachments.Add wPath & wFile
                            num_error = Err.Number
                            If num_error <> 0 Then
                                wks.Range("I" & i).Value = "ERROR Exceed Size"
                                sErr = True
                            End If
                            wFile = Dir()
                        Loop
                    Else
                        wks.Range("I" & i).Value = "ERROR Wrong File URL"
                        sErr = True
                    End If
                    On Error GoTo 0
                Else
                    wks.Range("I" & i).Value = "ERROR Wrong Folder URL"
                    sErr = True
                End If
            End If
            If sErr = False Then
                .Send
                '.display 'disable display and enable send to send automatically
                num_error = Err.Number
                If num_error <> 0 Then
                    wks.Range("I" & i).Value = Err.Description
                Else
                    wks.Range("I" & i).Value = "Email Send!"
                End If
            End If
            Application.Wait (Now + TimeValue("0:00:07")) 'Pausing an application for 3s, before next email
        End With
    Next i
    MsgBox "E-mail successfully sent", 64
    Application.DisplayAlerts = False
    Set Mail_Object = Nothing
End Sub

---

See: https://www.snb-vba.eu/VBA_Outlook_e...n.html#L_5.2.2

Quote:

---

Originally Posted by snb

See: https://www.snb-vba.eu/VBA_Outlook_e...n.html#L_5.2.2

---

how do i add this into script in excel?

Code:

---


c00 = "controle"

With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(5).Items(c00).Move .GetDefaultFolder(3)
End With
End Sub

---

try this in outlook 2019
got error..

Quote:

---

Originally Posted by snb

See: https://www.snb-vba.eu/VBA_Outlook_e...n.html#L_5.2.2

---

What is your account type? The usual method probably works only on pop3. IMAP is a problem and Exchange has security restrictions. As such, it is probably best to run a separate macro sometime to move the emails from Sent folder to a preferred folder.

You cross-posted to: https://www.ozgrid.com/forum/forum/h...ve-sent-folder

The "error" to your site snb is:

Code:

---

Your connection is not private

Attackers might be trying to steal your information fromwww.snb-vba.eu (for example, passwords, messages, or credit cards). Learn more

NET::ERR_CERT_COMMON_NAME_INVALID

---

Hi.
It ok. I got another code which work on Outlook BUT had some issue here is... the code wont auto run every 1 sec
or auto run.

Code:

---

Sub MoveSentItem()


On Error Resume Next
    Dim objFolder As Outlook.MAPIFolder, olFolderSentMail As Outlook.MAPIFolder
    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem


    Set objNS = Application.GetNamespace("MAPI")
    Set olFolderSentMail = objNS.GetDefaultFolder(olFolderSentMail)
    'For the "Item" portion, I used the name of the folder exactly as it appear in the ToolTip when I hover over it.
    Set objFolder = objNS.Folders.Item("SENT_ARCHIVE").Folders.Item("Sent Items")


'Assume this is a mail folder


    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
    End If


    If Application.ActiveExplorer.Selection.Count = 0 Then
        'Require that this procedure be called only when a message is selected
        Exit Sub
    End If
    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.Move objFolder
            End If
        End If
    Next
End Sub

---