Macro to add date/time stamp to subject

Status
Not open for further replies.

mdfb42

New Member
Outlook version
Outlook 2013 32 bit
Email Account
Outlook.com (as MS Exchange)
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!
 

Attachments

  • Date Stamp macro.PNG
    Date Stamp macro.PNG
    17.4 KB · Views: 809
You forgot the subject.

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


To remove duplicate prefixes:

Code:
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
 
@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!
 
You forgot the subject.

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


To remove duplicate prefixes:

Code:
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.
 
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
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
L Macro to add Date & Time etc to "drag to save" e-mails Outlook VBA and Custom Forms 17
A Email Macro to add Date and Classification Outlook VBA and Custom Forms 2
C Macro to add multiple recipients to message Outlook VBA and Custom Forms 3
S Example VBA Macro - To Conditionally Change the From Account and Add a BCC Address on Emails Outlook VBA and Custom Forms 11
Tanja Östrand Outlook 2016 - Create Macro button to add text in Subject Outlook VBA and Custom Forms 1
snhnic Macro that does not overwrite but add a number Outlook VBA and Custom Forms 1
W Macro to add a word in Subject Line Using Outlook 1
L Macro to Add Catgegory to List of Contacts Using Outlook 4
L Outlook 2007 Macro to Add Text to a Contact Field Using Outlook 10
W Add to Calendar links - auto accept with macro Using Outlook 1
B Auto BCC VBA macro: how to add exceptions? Using Outlook 28
M How to Create Macro in Visual Basic to add Contacts from Personal Folder Using Outlook 4
E Macro to add text to a Message Outlook VBA and Custom Forms 3
P How do I create a macro to add contacts from email messages? Outlook VBA and Custom Forms 1
D Call add-in method from macro? Outlook VBA and Custom Forms 1
X Custom icon (not from Office 365) for a macro in Outlook Outlook VBA and Custom Forms 1
X Run macro automatically when a mail appears in the sent folder Using Outlook 5
mrrobski68 Issue with Find messages in a conversation macro Outlook VBA and Custom Forms 1
G Creating Macro to scrape emails from calendar invite body Outlook VBA and Custom Forms 6
M Use Macro to change account settings Outlook VBA and Custom Forms 0
J Macro to Reply to Emails w/ Template Outlook VBA and Custom Forms 3
C Outlook - Macro to block senders domain - Macro Fix Outlook VBA and Custom Forms 1
Witzker Outlook 2019 Macro to seach in all contact Folders for marked Email Adress Outlook VBA and Custom Forms 1
S macro error 4605 Outlook VBA and Custom Forms 0
A Macro Mail Alert Using Outlook 4
J Outlook 365 Outlook Macro to Sort emails by column "Received" to view the latest email received Outlook VBA and Custom Forms 0
J Macro to send email as alias Outlook VBA and Custom Forms 0
M Outlook Macro to save as Email with a file name format : Date_Timestamp_Sender initial_Email subject Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro GoTo user defined search folder Outlook VBA and Custom Forms 6
D Outlook 2016 Creating an outlook Macro to select and approve Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro to send an Email Template from User Defined Contact Form Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro to check Cursor & Focus position Outlook VBA and Custom Forms 8
V Macro to mark email with a Category Outlook VBA and Custom Forms 4
M Outlook 2019 Macro not working Outlook VBA and Custom Forms 0
S Outlook 365 Help me create a Macro to make some received emails into tasks? Outlook VBA and Custom Forms 1
Geldner Send / Receive a particular group via macro or single keypress Using Outlook 1
D Auto Remove [EXTERNAL] from subject - Issue with Macro Using Outlook 21
V Macro to count flagged messages? Using Outlook 2
sophievldn Looking for a macro that moves completed items from subfolders to other subfolder Outlook VBA and Custom Forms 7
S Outlook Macro for [Date][Subject] Using Outlook 1
E Outlook - Macro - send list of Tasks which are not finished Outlook VBA and Custom Forms 3
E Macro to block senders domain Outlook VBA and Custom Forms 1
D VBA Macro to Print and Save email to network location Outlook VBA and Custom Forms 1
N VBA Macro To Save Emails Outlook VBA and Custom Forms 1
N Line to move origEmail to subfolder within a reply macro Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro to answer a mail with attachments Outlook VBA and Custom Forms 2
A Outlook 2016 Macro to Reply, ReplyAll, or Forward(but with composing new email) Outlook VBA and Custom Forms 0
J Macro to Insert a Calendar Outlook VBA and Custom Forms 8
W Macro to Filter Based on Latest Email Outlook VBA and Custom Forms 6
T Macro to move reply and original message to folder Outlook VBA and Custom Forms 6

Similar threads

Back
Top