Outlook 自動配置腳本

目前有這樣一個客戶需求:在一期專案當中,用戶端不加入域,但要求配置並使用用戶端的Outlook。由於用戶端數量較大(大約1200個),手工配置太繁瑣,工作量也非常
巨大,因此寫了一個Outlook用戶端配置腳本,順便提供大家一個參考。
1、我們需要有一個Outlook配置檔(PRF檔),此配置檔的生成及具體參數請參考
http://technet.microsoft.com/zh-cn/library/cc179062(TechNet.10).aspx

2、執行寫好的腳本將配置檔導入並配置Outlook用戶端即可(PRF配置檔需要與腳本在同一目錄,並在腳本中指定PRF檔的名稱)

3、腳本內容

'===================================================================
'
' VBScript Source File
'
' NAME: Billy Fu
'
' AUTHOR: Outlook配置腳本-Outlook_Profile_Config
'
' DATE : 2008/7/14 '
'
'===================================================================
ON ERROR RESUME NEXT

Const OFFICE11_PATH = "C:\Program Files\Microsoft Office\Office11"
Const OFFICE12_PATH = "C:\Program Files\Microsoft Office\Office12"

dim strUserName
dim intOfficeVer
dim strOfficePath

strUserName = ""
intOfficeVer = ""
strOfficePath = ""

strUserName = InputBox("請輸入您在域中的用戶帳號,格式如:BillyFu","Outlook配置腳本")
If strUserName = "" Then
Msgbox "取消Outlook配置!"
Else
while intOfficeVer = ""
intOfficeVer = InputBox("請輸入您本機安裝的Outlook版本號:2007或2003,其他版本不支持","Outlook配置腳本","2003")
if intOfficeVer = "" then
Msgbox "Outlook 設置取消!"
intOfficeVer = "error"
else
if intOfficeVer <> "2007" And intOfficeVer <> "2003" Then
intOfficeVer = ""
else
if intOfficeVer = "2007" then
strOfficePath = OFFICE12_PATH
else
strOfficePath = OFFICE11_PATH
end if
strOfficePath = InputBox("請確定您本機安裝的Outlook路徑","Outlook配置腳本",strOfficePath)
Call InstallOutlookProfile
end if
end if
Wend
End If

sub InstallOutlookProfile

ModifyPRFFile

Dim WshShell
Set WshShell = Wscript.CreateObject("Wscript.Shell")

Dim strPath
strPath = WScript.ScriptFullName
strPath = Left(strPath, InstrRev(strPath, "\")) & "OutlookProfile1.PRF"
'指定Outlook PRF 配置檔

dim strCmd
strCmd = """" & strOfficePath & "\outlook.exe"" /importprf """ & strPath
& """"
WshShell.Run strCmd, 1, false
end sub

sub ModifyPRFFile

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim strCon

Dim fso, f1, f2, ts
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.GetFile("OutlookProfile.PRF") '設置從Outlook配置檔中讀取資訊
Set ts = f1.OpenAsTextStream(ForReading, TristateUseDefault)
strCon = ts.ReadAll
ts.close

strCon = Replace(strCon,"%UserName%",strUserName)

fso.CreateTextFile "OutlookProfile1.PRF"
Set f2 = fso.GetFile("OutlookProfile1.PRF") '創建一個配置檔
Set ts = f2.OpenAsTextStream(ForWriting, TristateUseDefault)
ts.Write strCon
ts.Close

end sub

sub Err

if err <> 0 then
Wscript.echo "Outlook配置腳本出錯,自動退出!"
Err.Clear
end if

end sub