Outlook VBA to add number of file and date into subject line

[LaurenHancy]

Good morning All!

Please may you help me. I am trying to add a number sequence and the date the email was sent/recieved into the subject line of emails.

For Example:

1 - 07 01 2021
2 - 07 01 2021
3 - 08 01 2021
4 - 10 01 2021

Is anybody able to help advise on this? Apologies, I am quite new to VBA coding.

Have a good day

L

 

[ER_Neha]

do you have the number sequence and the dates recorded in any column of the excel sheet? basically I am asking from where you are getting the data

 

[LaurenHancy]

do you have the number sequence and the dates recorded in any column of the excel sheet? basically I am asking from where you are getting the data

Hi, thanks for your reply, this post isn’t about excel, it’s outlook. Changing the subject line to number of email in folder and inserting the date received or sent with a via code and macro

 

[GWteB]

Hi LaurenHancy, it's likely that the code below is doing what you want. I would strongly recommend you to create a separate folder to copy some outlook items in. The code makes adjustments (as intended) and those actions are not reversable.
To implement the code open your Outlook and step into te VBA Editor (VBE) by pressing ALT F11. If it's not displayed yet press CTRL R to open the Project Explorer's window. A project with the name Project1 should be visible. Click on menu > Insert > Module and a new window opens. Its title bar should say "Project 1 - [Module 1 (Code)]"
Paste the code below in the module window and press CTRL S to save this project on disk. Caption of the title bar should be changed to "VbaProject.OTM - [Module 1 (Code)]". Now close the VBE.
Back in Outlook press ALT F8 to open the Macros dialog. Click on your macro, click the Run button and choose the folder you created beforehand for test purposes. See if this works for you.

Public Sub Adjust_Subject_EmailItems()
    
    Dim oNS         As Outlook.Namespace
    Dim oFldr       As Outlook.Folder
    Dim Itms        As Outlook.Items
    Dim Itm         As Outlook.MailItem
    Dim sSubject    As String
    Dim sAddress    As String
    Dim n           As Long

    Set oNS = Outlook.Application.GetNamespace("MAPI")
    Set oFldr = oNS.PickFolder
    If Not oFldr Is Nothing Then
        Set Itms = oFldr.Items
        If Itms.Count > 0 Then
            sAddress = Outlook.Application.Session.CurrentUser.Address
            For Each Itm In Itms
                If TypeOf Itm Is MailItem Then
                    n = n + 1
                    With Itm
                        If .SenderEmailAddress = sAddress Then
                            .Subject = Format(n, "000") & " Sent: " & Format(.SentOn, "dd mm yyyy") & " |> " & .Subject
                        Else
                            .Subject = Format(n, "000") & " Rcvd: " & Format(.ReceivedTime, "dd mm yyyy") & " |> " & .Subject
                        End If
                        .Save
                    End With
                End If
                DoEvents
            Next Itm
            MsgBox "In folder " & oFldr.FullFolderPath & vbNewLine & n & " email items have been changed.", vbInformation
        Else
            MsgBox "In folder " & oFldr.FullFolderPath & vbNewLine & "are no items to process.", vbInformation
        End If
    End If
End Sub

 

[LaurenHancy]

Hi I am so sorry, I have only just seen your response.

This is great, however I no longer need the number at the beginning, I just need to have the date as "yyyy mm dd"

Thank you and sorry again for no responding to you.