Set Outlook Hompepage for New Folder in Inbox




I have managed to use a vbscript to create a new folder in all user
Outlook, I need to go one step further and set the hompepage to a
spesific URL we have 2000 users so going around to the desktops do not
appeal :)

Below is an overview of the script being used and the folder creation
' This script has been designed to enumerate users only in a specific
OU (OU is determined by user input when executing the script) once
complete, AD is queried for the users mailbox.
' Following the above, users and their mailbox id are used to call a
function, during the function
' the users mailbox is accessed to check for folder names that exists
in the root of their mailbox,
' all folder names are output, per user, to a text file (location
determined by user input). If the
' referenced folder name does not exists it is created, followed by a
cross check to confirm it has
' been created correctly.

'Folder Creation Function
' **********************

Function CreateMailFolder(aMailhome, sLogon, sFoldername,

dim application, cdosession
dim strProfileInfo
dim objFolder, folder
Dim cdoInfoStore, cdofolderstore, objsession, objFolders,
ObjStore, aNames, readtext, text, f, fso, of

set cdosession = createobject("mapi.session")

strProfileInfo = aMailhome & vbLf & sLogon
cdosession.Logon "", "", False, True, 0, False, strProfileInfo

If Err.Number = 0 Then
' wscript.echo Err.Number
End If

Set objFolder = cdosession.Inbox
Set objstore =

If objFolder Is Nothing Then
wscript.echo "Failed to open Inbox"
End If

const ForReading = 1, ForWriting = 2, ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(sFileLocation) Then

Set objFolder = fso.CreateFolder(sFileLocation)
End If

Set f = fso.OpenTextFile(sFileLocation & "\" & sLogon & ".txt",

ForWriting, True)
Set of = fso.OpenTextFile(sFileLocation & "\" & sLogon &
ForReading, True)

For Each objFolders In objstore.rootfolder.folders

f.writeline "****First Read Complete***"
f.writeline ""

readtext = of.ReadAll
text = "_Message Centre"

If InStr (readtext, text) Then
wscript.echo "Folder Already Exists for - " & sLogon
set folder =
objstore.RootFolder.Folders.Add(sFoldername ,6)
wscript.echo "Folder will be created for - " & sLogon
oErr = 22
CreateMailFolder = err.number
End If

If oErr = 22 Then
For Each objFolders In objstore.rootfolder.folders
readtext = of.ReadAll
If InStr (readtext, text) Then
wscript.echo "Folder has been successfully
created for " & sLogon
wscript.echo "Folder was not successfully
created for - " & sLogon
CreateMailFolder = err.number
End If
End If

Set fso = Nothing
Set f = Nothing
Set readtext = Nothing
Set text = Nothing
Set of = Nothing

End Function



Sue Mosher [MVP-Outlook]

See my response to your post in another group.

Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question