This script enables oma (outlook mobile access) based on a list of smtp addresses in an excel sheet.

What the script does:

• get the users smtp address from the excel sheet (c:\temp\oma.xls)
• the function FindDN finds the corresponding distinguished name of the user object
• the function EnableOma enables oma for the user
• the function LogPrint creates logging for all actions

Follow the next steps to run the script (admin rights needed):

• create an excel sheet with a list of smtp addresses to be oma enabled
• save the sheet as c:\temp\oma.xls
• copy and paste the script in your favorite text editor
• save the script (for example c:\temp\enableoma.vbs)
• open a command prompt
• go to “c:\temp”
• give “cscript enableoma.vbs” (without quotes) and enter

The script:

' Name : enableoma.vbs
' Description : script to enable oma (outlook mobile access) from an excel sheet
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 06-04-2010

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\temp\oma.xls")
intRow = 2
Do Until objExcel.Cells(intRow,1).Value = ""
    strSmtpAddress = objExcel.Cells(intRow, 1).Value
    If strSmtpAddress <> "" Then
		strDN = FindDN strSmtpAddress
		EnableOma strDN
		Logprint "outlook mobile access is enabled for ; " & strSmtpAddress
	End If
	intRow = intRow + 1
Loop
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

Function EnableOma(strAccount)
	Set objUser = GetObject ("LDAP://" & strAccount)
	objUser.Put "msExchOmaAdminWirelessEnable", "0"
	objUser.setinfo
	Set objUser = Nothing
End Function

Function LogPrint(Message)
Const ForAppending = 8
strDate = Replace(Date,"/","-")
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = ObjFSO.OpenTextFile(strDate & "-OmaEnabledAgain.csv", ForAppending, True)
    objTextFile.WriteLine Message
    objTextFile.Close
Set objTextFile = Nothing
Set ObjFSO = Nothing
End Function

Function FindDN(strSmtp)

	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

	Set objRootDSE = GetObject("LDAP://RootDSE")
	strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"

	' Filter on user objects.
	strFilter = "(mail=" & strSmtp & ")"

	' Comma delimited list of attribute values to retrieve.
	strAttributes = "distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute
	FindDN = adoRecordset.Fields("distinguishedName").Value

	' Clean up.
	adoRecordset.Close
	adoConnection.Close

	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing
End Function

When you have problems/questions please post a reply, you can also rate the script.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV