Edit all emails in folder with the same note and then move to another folder

[missnk]

Hi Everyone,

I hope you can help me. n00bie here. :p

I action emails during the day and I move the actioned emails to a separate folder that only I use called "Actioned today". At the end of the day, I can go to that one folder and quickly count the amount of emails I have actioned.

At the moment, I open up about 10 emails at a time and click on a macro button to make the macro:

1. edit the email by adding a note to the top of the email
2. moving it to a shared "closed" box with a million other emails
3. email is subsequently closed.


I just keep on clicking on the macro button until all the emails are closed and open another 10 emails until all the emails in the "Actioned today" email folder is gone.

It used to be okay, but because of the influx of emails, I have to do this for 50+ emails a day and my computer gets slow and laggy from trying to open and then process the open emails.


I would like a macro which could automatically go into each email in a particular email folder and edit the email by adding a note to the top of the email, then moving it to the shared "closed" box.

Basically I'm trying to eliminate the need of manually opening each email and clicking on the macro button 100times.

I did write something up but it didn't work and it looked so mediocre I just Ctrl+A and Deleted it out of frustration!


I hope you can help me


My current code: (I know it is a bit messy but it works!)

Sub CloseEmail()
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim msg As Outlook.MailItem
    Dim objItem As Object
    Dim strStamp As String
        
    On Error Resume Next
    
    'Housekeeping with current open item
         Set objOL = Application
         Set objItem = objOL.ActiveInspector.CurrentItem
         If Not objItem Is Nothing Then
       
        'Force plain text emails to HTML format
               Set objItem.BodyFormat = olFormatHTML
               Set objNS = objOL.Session


        'Type info in body of email
               objItem.HTMLBody = "<p> Closed by Operator. Replied on " & Date & vbCrLf & objItem.HTMLBody
  
        'Housekeeping set Destination Folder
        Set objFolder = Application.GetNamespace("MAPI").Folders.Item("email@organisation.com").Folders.Item("Folders").Folders.Item("Completed").Folders.Item("Closed")
        On Error GoTo 0

    'Error Message if folder not found
    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
        
        Exit Sub
            End If
             End If
                   

          'Move email to destination folder
          objItem.Move objFolder
   

    Set objOL = Nothing
    Set objItem = Nothing
End Sub