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