Dim colStores 'As Outlook.Stores Dim oStore 'As Outlook.Store Dim oRoot 'As Outlook.folder Dim oldName Dim newName 'As String Dim objSysInfo, objUser On Error Resume Next Set objSysInfo = CreateObject("ADSystemInfo") Set objUser = GetObject("LDAP://" & objSysInfo.UserName) Set objOutlook = CreateObject("Outlook.Application") Set colStores = objOutlook.Session.Stores oldName = objUser.sAMAccountName & "@OLD.org.uk" newName = objUser.sAMAccountName & "@NEW.co.uk" For Each oStore In colStores Set oRoot = oStore.GetRootFolder If oRoot = oldName Then oRoot.Name = newName End If WScript.Echo "Name changed to: " & newName Next