Macro to add date/time stamp to subject

[mdfb42]

Hi all,

A complete Outlook macro newbie here (and a macro newbie in general). I have been trying to get a macro to work to add a date/time stamp to the subject of all emails in the selected outlook folder. I am receiving an error on my 'check' line to avoid duplication of the date/time stamp on emails that the macro has already ran on. The below is my macro. it works as planned, except for the If formula to decide to skip an email or not. Any help resolving this issue would be GREATLY appreciated.

Sub AddFileName2()
Dim myolApp As Outlook.Application
Dim aItem As Object
Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder
Dim iItemsUpdated As Integer
Dim strTemp As String
Dim strFilenum As String
iItemsUpdated = 0
For Each aItem In mail.Items
strTemp = aItem.ReceivedTime & " " & aItem.Subject
If Left(aItem, 8) = Left(aItem.ReceivedTime, 8) Then GoTo Skip
aItem.Subject = strTemp
iItemsUpdated = iItemsUpdated + 1
aItem.Save
Skip:
Next aItem
MsgBox iItemsUpdated & " of " & mail.Items.Count & " Messages Updated"
Set myolApp = Nothing
End Sub

Additionally, if anyone is interested in bonus points, I had to add in this check after I duplicated the macro and therefore the date/time stamp on some emails. If there's an easy variation to have another macro to remove the date/time stamp form the subject line, that would also be a huge help.

Thank you in advance!

 

[niton]

You forgot the subject.

If Left(aItem.subject, 8) = Left(aItem.ReceivedTime, 8) Then GoTo Skip

To remove duplicate prefixes:

Option Explicit

Sub PrefixReceivedTime_RemoveDuplicate()

    Dim aItem As Object
    Dim aMail As mailItem
    Dim aSubject As String
    
    Dim mailFldr As folder
    
    Dim iItemsUpdated As Long
        
    Dim left_Subject As String
    Dim prefixStr  As String
    Dim lenPrefix As Long
    
    Set mailFldr = ActiveExplorer.CurrentFolder
        
    For Each aItem In mailFldr.Items
        
        If aItem.Class = olMail Then
            
            Set aMail = aItem
            prefixStr = aMail.ReceivedTime & " "
            lenPrefix = Len(prefixStr)
            aSubject = aMail.subject
            
            left_Subject = Left(aSubject, 2 * lenPrefix)
            Debug.Print left_Subject
                        
            If left_Subject = prefixStr & prefixStr Then
                aMail.subject = Right(aSubject, Len(aSubject) - lenPrefix)
                Debug.Print aMail.subject
                aMail.Save
                iItemsUpdated = iItemsUpdated + 1
           End If
            
        End If

    Next aItem
    
    MsgBox iItemsUpdated & " of " & mailFldr.Items.count & " Messages Updated"
 
End Sub

 

[mdfb42]

@niton Thank you so much! That is exactly what I was missing, and huge bonus points for helping me remove my duplicates.

Now it's time for me to educate myself by walking through the macro you wrote to increase my understanding as a whole.

Have a great day!

 

[newuser]

You forgot the subject.

If Left(aItem.subject, 8) = Left(aItem.ReceivedTime, 8) Then GoTo Skip

To remove duplicate prefixes:

Option Explicit

Sub PrefixReceivedTime_RemoveDuplicate()

    Dim aItem As Object
    Dim aMail As mailItem
    Dim aSubject As String
   
    Dim mailFldr As folder
   
    Dim iItemsUpdated As Long
       
    Dim left_Subject As String
    Dim prefixStr  As String
    Dim lenPrefix As Long
   
    Set mailFldr = ActiveExplorer.CurrentFolder
       
    For Each aItem In mailFldr.Items
       
        If aItem.Class = olMail Then
           
            Set aMail = aItem
            prefixStr = aMail.ReceivedTime & " "
            lenPrefix = Len(prefixStr)
            aSubject = aMail.subject
           
            left_Subject = Left(aSubject, 2 * lenPrefix)
            Debug.Print left_Subject
                       
            If left_Subject = prefixStr & prefixStr Then
                aMail.subject = Right(aSubject, Len(aSubject) - lenPrefix)
                Debug.Print aMail.subject
                aMail.Save
                iItemsUpdated = iItemsUpdated + 1
           End If
           
        End If

    Next aItem
   
    MsgBox iItemsUpdated & " of " & mailFldr.Items.count & " Messages Updated"

End Sub

Hi all,

A complete Outlook macro newbie here (and a macro newbie in general). I have been trying to get a macro to work to add a date/time stamp to the subject of all emails in the selected outlook folder. I am receiving an error on my 'check' line to avoid duplication of the date/time stamp on emails that the macro has already ran on. The below is my macro. it works as planned, except for the If formula to decide to skip an email or not. Any help resolving this issue would be GREATLY appreciated.

Sub AddFileName2()
Dim myolApp As Outlook.Application
Dim aItem As Object
Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder
Dim iItemsUpdated As Integer
Dim strTemp As String
Dim strFilenum As String
iItemsUpdated = 0
For Each aItem In mail.Items
strTemp = aItem.ReceivedTime & " " & aItem.Subject
If Left(aItem, 8) = Left(aItem.ReceivedTime, 8) Then GoTo Skip
aItem.Subject = strTemp
iItemsUpdated = iItemsUpdated + 1
aItem.Save
Skip:
Next aItem
MsgBox iItemsUpdated & " of " & mail.Items.Count & " Messages Updated"
Set myolApp = Nothing
End Sub

Additionally, if anyone is interested in bonus points, I had to add in this check after I duplicated the macro and therefore the date/time stamp on some emails. If there's an easy variation to have another macro to remove the date/time stamp form the subject line, that would also be a huge help.

Thank you in advance!

I copied and ran your macro and I want to know how to delete it now. Any help is appreciated. I probably shouldn't have done it in the first place because I really have no idea what I am doing.

 

[Diane Poremsky]

You need to delete the macro? Open the VBA editor (alt+F11), find, delete it and save... if its the only macro, close outlook, type or paste %appdata%\microsoft\outlook into the address bar of file explorer then press Enter. Delete VbaProject.OTM