Renaming Outlook System folders Part 2 (VBA Macro)

The Microsoft Outlook 2000 VBA macro, which can be used to change the Outlook default folder names.
Open the VBA macro with notepad and copy the code into the clipboard.

Open Outlook 2000 and select ‘Tools’, ‘Macros’, ‘Visual Basic Editor’ to open the Outlook 2000 VBA editor.
Expand the ‘ThisOutlookSession’ in the left-hand project window and paste the code into empty the right-hand window.

Select ‘Tools’, ‘References’ in the Outlook 2000 VBA editor and make sure ‘Microsoft CDO 1.21’ is selected.
Note that Outlook 2000 does not install CDO 1.21 by default. If you don’t see it in the Outlook VBA references
dialog CDO 1.21 might not be installed on your machine. If so, you have to run the Office 2000/Outlook 2000 setup
from CDO-ROM again and make sure CDO 1.21 is selected.

Close the Outlook 2000 VBA editor to save the changes.

To run the Outlook 2000 VBA macro open Outlook and chose ‘Tools’, ‘Macro’, ‘Macros’, select the desired macro and hit ‘Run’


Option Explicit

‘THIS CODE AND INFORMATION IS PROVIDED “AS IS” WITHOUT
‘WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
‘INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
‘OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR
‘PURPOSE

‘——————————————————————————
‘ FILE DESCRIPTION: The macro ChangeFolder changes the name of all Outlook
‘ Default Folders to the language of your choice.
‘ AUTHOR: Siegfried Weber, http://www.cdolive.com
‘ VERSION INFO: Ver 1.0, 14 Jan 2000

‘ Copyright (c) 2000, free public use permitted with attribution
‘——————————————————————————

Sub ChangeFolder()

‘ Initialize error handling
On Error Resume Next

‘ MAPI property to access Drafts folder
Const CdoPR_Drafts = &H36D70102

‘Tyska
‘Const FOLDER_CALENDAR = “Kalender”
‘Const FOLDER_CONTACTS = “Kontakte”
‘Const FOLDER_DELETEDITEMS = “Gelöschte Objekte”
‘Const FOLDER_INBOX = “Posteingang”
‘Const FOLDER_JOURNAL = “Journal”
‘Const FOLDER_NOTES = “Notizen”
‘Const FOLDER_OUTBOX = “Postausgang”
‘Const FOLDER_SENTITEMS = “Gesendete Objekte”
‘Const FOLDER_TASKS = “Aufgaben”
‘Const FOLDER_DRAFTS = “Entwürfe”

‘Svenska
Const FOLDER_CALENDAR = “Kalender”
Const FOLDER_CONTACTS = “Kontakter”
Const FOLDER_DELETEDITEMS = “Borttaget”
Const FOLDER_INBOX = “Inkorgen”
Const FOLDER_JOURNAL = “Journal”
Const FOLDER_NOTES = “Anteckningar”
Const FOLDER_OUTBOX = “Utkorgen”
Const FOLDER_SENTITEMS = “Skickat”
Const FOLDER_TASKS = “Uppgifter”
Const FOLDER_DRAFTS = “Utkast”

‘Norska
‘Const FOLDER_CALENDAR = “Kalender”
‘Const FOLDER_CONTACTS = “Kontakter”
‘Const FOLDER_DELETEDITEMS = “Slettede Elementer”
‘Const FOLDER_INBOX = “Innboks”
‘Const FOLDER_JOURNAL = “Logg”
‘Const FOLDER_NOTES = “Notater”
‘Const FOLDER_OUTBOX = “Utboks”
‘Const FOLDER_SENTITEMS = “Sendte Elementer”
‘Const FOLDER_TASKS = “Oppgaver”
‘Const FOLDER_DRAFTS = “Kladd”

‘Danska
‘Const FOLDER_CALENDAR = “Kalender”
‘Const FOLDER_CONTACTS = “Kontakter”
‘Const FOLDER_DELETEDITEMS = “Borttaget”
‘Const FOLDER_INBOX = “Inkorgen”
‘Const FOLDER_JOURNAL = “Journal”
‘Const FOLDER_NOTES = “Anteckningar”
‘Const FOLDER_OUTBOX = “Utkorgen”
‘Const FOLDER_SENTITEMS = “Skickat”
‘Const FOLDER_TASKS = “Uppgifter”
‘Const FOLDER_DRAFTS = “Utkast”

‘Engelska
‘Const FOLDER_CALENDAR = “Calendar”
‘Const FOLDER_CONTACTS = “Contacts”
‘Const FOLDER_DELETEDITEMS = “Deleted Items”
‘Const FOLDER_INBOX = “Inbox”
‘Const FOLDER_JOURNAL = “Journal”
‘Const FOLDER_NOTES = “Notes”
‘Const FOLDER_OUTBOX = “Outbox”
‘Const FOLDER_SENTITEMS = “Sent Items”
‘Const FOLDER_TASKS = “Tasks”
‘Const FOLDER_DRAFTS = “Drafts”

‘ Declare variables
Dim objSession As MAPI.Session
Dim objFolder As MAPI.Folder
Dim objInboxFolder As MAPI.Folder
Dim objFields As MAPI.Fields
Dim strEntryID As String

‘ Initialize variables
Set objSession = Nothing
Set objFolder = Nothing
Set objInboxFolder = Nothing
Set objFields = Nothing

‘ Create CDO session and logon
Set objSession = New MAPI.Session

‘ Check if CDO session created
If Not objSession Is Nothing Then

‘ CDO session logon
Err.Clear
objSession.Logon “”, “”, ShowDialog:=False, NewSession:=False

‘ Check if CDO session logon successful
If Err.Number = 0 Then

‘ Get default calendar folder
Err.Clear
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_CALENDAR

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default contact folder
Err.Clear
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderContacts)

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_CONTACTS

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default deleted items folder
Err.Clear
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderDeletedItems)

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_DELETEDITEMS

‘ Save change
s

Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default inbox folder
Err.Clear
Set objFolder = objSession.Inbox

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_INBOX

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default journal folder
Err.Clear
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderJournal)

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_JOURNAL

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default notes folder
Err.Clear
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderNotes)

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_NOTES

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default outbox folder
Err.Clear
Set objFolder = objSession.Outbox

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_OUTBOX

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default sent items folder
Err.Clear
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderSentItems)

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_SENTITEMS

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default tasks folder
Err.Clear
Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderTasks)

‘ Check if folder found
If Err.Number = 0 Then

‘ Rename folder
objFolder.Name = FOLDER_TASKS

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Get default inbox folder
Set objInboxFolder = objSession.Inbox

‘ Get fields collection of inbox folder
Set objFields = objInboxFolder.Fields

‘ Get drafts folder entry ID
strEntryID = objFields.Item(CdoPR_Drafts).Value

‘ Check if entry ID found
Set objFolder = Nothing
If Trim(strEntryID) <> “” Then

‘ Get default drafts folder
Set objFolder = objSession.GetFolder(strEntryID, objInboxFolder.StoreID)
End If

‘ Check if folder found
If Not objFolder Is Nothing Then

‘ Rename folder
objFolder.Name = FOLDER_DRAFTS

‘ Save changes
Err.Clear
objFolder.Update MakePermanent:=True, RefreshObject:=True

‘ Check for possible errors
If Err.Number <> 0 Then

‘ Cannot change folder name, display error message
MsgBox “Could not change Outlook default folder name for: “ & objFolder.Name _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
End If

‘ Logoff
objSession.Logoff
MsgBox “Finished changing Outlook default folder names.”, vbInformation
Else

‘ Cannot logon to CDO session, display error message
MsgBox “Could not create CDO Session. Please check if CDO 1.x is installed on this computer.” _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If
Else

‘ Cannot create CDO session, display error message
MsgBox “Could not create CDO Session. Please check if CDO 1.x is installed on this computer.” _
& Chr(13) & Err.Number & Chr(13) & Err.Description, vbCritical
End If

‘ Tidy up
Set objSession = Nothing
Set objFolder = Nothing
Set objInboxFolder = Nothing
Set objFields = Nothing
End Sub

Leave a Reply