Script for bulk editing email subjects

[barbs706]

Hi guys.

I recently upgraded my email system to Office 365 with the 50GB mailbox limit. To fully utilise the capacity I thought I would import all of my old exchange emails (.MSG format)

I managed to find some software on the internet that converted the 84,146 (yes they are all important emails, no spam included!) into a .PST file. All good so far.

However, once I imported the .PST into my Outlook, all the email's subjects start with 'IMPORTED'

I have been looking on the internet for some VBA code to wiz through the mail folder and remove 'IMPORTED ' but I can only seem to find code that will do one email at a time.

If someone has the spare time, can you point me in the right direction?

Thanks in advance!

[gmayor]

The following will remove the Word IMPORTED (or whatever you set in strRemove) from the subject of all messages in the default Inbox or any of its sub folders. You can change the top folder as required and it will process the folders beneath.

Because the process takes a while to run it employs a userform progress bar. You can download this and import it into Outlook VBA from http://www.gmayor.com/Forum/frmProgress.zip .The macro won't work without it!


Sub BatchProcessFolders()
'Graham Mayor - http://www.gmayor.com
Dim cFolders As Collection
Dim olFolder As Outlook.Folder
Dim subFolder As Outlook.Folder
Dim olNS As Outlook.NameSpace
Dim sStore As String

Set cFolders = New Collection
Set olNS = GetNamespace("MAPI")
cFolders.Add olNS.GetDefaultFolder(olFolderInbox)
Do While cFolders.Count > 0
Set olFolder = cFolders(1)
cFolders.Remove 1
sStore = olFolder.Store
ProcessFolder olFolder
If olFolder.folders.Count > 0 Then
For Each subFolder In olFolder.folders
cFolders.Add subFolder
Next subFolder
End If
Loop
lbl_Exit:
Set olFolder = Nothing
Set subFolder = Nothing
Exit Sub
End Sub

Private Sub ProcessFolder(olMailFolder As Outlook.Folder)
'Graham Mayor - http://www.gmayor.com
Dim olItems As Outlook.Items
Dim olMailItem As Object
Dim i As Long
Dim ofrm As New frmProgress
Dim PortionDone As Double
Const strRemove As String = "IMPORTED" '- the text to remove

On Error GoTo err_Handler

Set olItems = olMailFolder.Items
ofrm.Show vbModeless
i = 0
For Each olMailItem In olItems
i = i + 1
PortionDone = i / olItems.Count
ofrm.Caption = olMailFolder.Name & " - Processing " & i & " of " & olItems.Count
ofrm.lblProgress.Width = ofrm.fmeProgress.Width * PortionDone
olMailItem.subject = Replace(olMailItem.subject, strRemove, "")
DoEvents
Next olMailItem
Unload ofrm
lbl_Exit:
Set ofrm = Nothing
Set olItems = Nothing
Set olMailItem = Nothing
Exit Sub
err_Handler:
MsgBox Err.Number & vbCr & Err.Description
Resume
End Sub

[barbs706]

Thanks GMayor for your speedy response.

I have ran the code but no changes happen. I get the progress bar come up and it goes through the Inbox and sub folder that these emails are in, but it does seem to go through them very fast (around 600 a second)

[gmayor]

Obviously I didn't have the messages in question to test, but the process should remove whatever you set in the line (and it does so quickly)
Const strRemove As String = "IMPORTED" '- the text to remove

The string is case sensitive and you should include any space or brackets or whatever before the subject proper.

However after further testing, it needs another line in the section of code below. Add the line in highlighted red.

For Each olMailItem In olItems
i = i + 1
PortionDone = i / olItems.Count
ofrm.Caption = olMailFolder.Name & " - Processing " & i & " of " & olItems.Count
ofrm.lblProgress.Width = ofrm.fmeProgress.Width * PortionDone
olMailItem.subject = Replace(olMailItem.subject, strRemove, "")
olMailItem.Save
DoEvents
Next olMailItem

[barbs706]

That worked perfectly, thanks so much gmayor! As the subjects were like this: IMPORTED Account Statement I used "IMPORTED " with the space to return the subjects back to normal.
I have a digital hording problem! I love to keep archives of emails and documents, but it has saved my skin a number of times!

Thanks again for your time and help!