Scripting

Ah...the old "group membership" chestnut...

There are a number of scripts knocking about to do this. Probably the most widely-known are Richard Mueller's 'IsMember[x].VBS' examples. As Richard explains, the "gotcha" with group membership is that the simplistic scripts don't pick up nested memberships, i.e. where a user isn't explicitly a member of GroupA but is a member of GroupB and where GroupB is a member of GroupA:

GroupA
Fred
Joe
*GroupB
Arthur

In this scenario, a simple test for Arthur's membership of GroupA would return False.

Here is a collection of functions based on Richard's work which I've used in the past. Note that the bare functionality has been altered for my particular purposes (e.g. only enumerating groups with a particular prefix) so you'll need to code around those. You'll also need to add code to connect to AD and so on, as well as that for creating the folder on the share etc. To explain a little, 'DN' is short-form for 'distinguishedName' and 'CN' for 'containerName'.Function GetMemberships(ByVal strDN, ByVal strCNPrefixToShow)
Dim strGroupCN
Dim blnAllowDisplay
Dim blnReturn_GetMemberships

GetMemberships = False

On Error Resume Next

dicGroups.RemoveAll

strLDAP = "LDAP://" & strDN

blnShowMessageIfSuccessful = True

Set objUser = GetObject(strLDAP)
strMsg = ""
strMsg = strMsg & "Create objUser object"

Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

Set objUserDN = GetObject("LDAP://" & strDN)

strMsg = ""
strMsg = strMsg & "Create objUserDN object"
Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

If IsEmpty(dicGroups) Then
blnReturn_GetMemberships = LoadGroups_tokenGroups(objUserDN, strCNPrefixToShow, strCNPrefixToIgnore)
End If

If Not dicGroups.Exists(objUserDN.sAMAccountName & "\") Then
'// The dictionary object is established, but group memberships for this DN must be added.
blnReturn_GetMemberships = LoadGroups_tokenGroups(objUserDN, strCNPrefixToShow, strCNPrefixToIgnore)
End If

'// Early on, I discovered that the 'tokenGroups' method doesn't return all memberships,
'// in spite of what the MS documentation says!
If Not dicGroups.Exists(objUserDN.sAMAccountName & "\") Then
blnReturn_GetMemberships = LoadGroups_memberOf(objUserDN, objUserDN, strCNPrefixToShow, strCNPrefixToIgnore)
End If

GetMemberships = True

On Error Goto 0
End Function

Function LoadGroups_tokenGroups(ByVal objADObject, ByVal strCNPrefixToShow, ByVal strCNPrefixToIgnore)
'// Subroutine to populate dictionary object with group memberships.
'// dicGroups is a dictionary object, with global scope.
'// It keeps track of group memberships for each user or computer separately.
'// ADO is used to retrieve the name of the group corresponding to each objectSid
'// in the tokenGroup array.

Dim arrGroups
Dim intIndex
Dim strBase
Dim strFilter
Dim objRS_Groups
Dim strGroupsAMAccountName
Dim strQuery
Dim strAttributes
Dim strADObjectsAMAccountName
Dim blnIsOKToAdd

intPrefixToShowLength = Len(strCNPrefixToShow)
intPrefixToIgnoreLength = Len(strCNPrefixToIgnore)

strBase = "<LDAP://" & strDNSDomain & ">"

'// Retrieve NT name of each group
strAttributes = "sAMAccountName"

LoadGroups_tokenGroups = False

'// Add user name to dictionary object, so LoadGroups need only be called once for each AD object
strADObjectsAMAccountName = objADObject.sAMAccountName
strMsg = ""
strMsg = strMsg & "Get 'sAMAccountName' method for objADObject"
Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

If Not dicGroups.Exists(strADObjectsAMAccountName & "\") Then
dicGroups.Add strADObjectsAMAccountName & "\", True
End If

'// Retrieve tokenGroups array, a calculated attribute
objADObject.GetInfoEx Array("tokenGroups"), 0
strMsg = ""
strMsg = strMsg & "Get 'GetInfoEx' method for objADObject"
Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

arrGroups = objADObject.Get("tokenGroups")
strMsg = ""
strMsg = strMsg & "Create array using 'Get(" & Chr(34) & "tokenGroups" & Chr(34) & " for objADObject"
Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

'// Create a filter to search for groups with objectSid equal to each value in tokenGroups array
strFilter = "(|"

If TypeName(arrGroups) = "Byte()" Then
'// tokenGroups has one entry
strFilter = strFilter & "(objectSid=" & OctetToHexStr(arrGroups) & ")"
ElseIf UBound(arrGroups) > -1 Then
'// tokenGroups is an array of two or more objectSids
For intIndex = 0 To UBound(arrGroups)
strFilter = strFilter & "(objectSid=" & OctetToHexStr(arrGroups(intIndex)) & ")"
Next
Else
'// tokenGroups have no objectSIDs
Exit Function
End If

strFilter = strFilter & ")"

'// Use ADO to search for groups whose objectSid matches any of the tokenGroups values for this user or computer
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

objADOCommand.CommandText = strQuery

Set objRS_Groups = objADOCommand.Execute

'// Enumerate groups and add NT name to dictionary object
With objRS_Groups
Do Until .EOF
strGroupsAMAccountName = .Fields("sAMAccountName").Value

blnIsOKToAdd = False

'// This looks a bit tortuous but I find this method is easier to read/maintain
'// than one huge line of Ands and Ors.
If intPrefixToShowLength = 0 And intPrefixToIgnoreLength = 0 Then
blnIsOKToAdd = True

ElseIf intPrefixToShowLength = 0 And intPrefixToIgnoreLength > 0 Then
If UCase(Left(strGroupsAMAccountName, intPrefixToIgnoreLength)) <> UCase(strCNPrefixToIgnore) Then
blnIsOKToAdd = True
End If

ElseIf intPrefixToShowLength > 0 And intPrefixToIgnoreLength = 0 Then
If UCase(Left(strGroupsAMAccountName, intPrefixToShowLength)) = UCase(strCNPrefixToShow) Then
blnIsOKToAdd = True
End If

ElseIf intPrefixToShowLength > 0 And intPrefixToIgnoreLength > 0 Then
If (UCase(Left(strGroupsAMAccountName, intPrefixToShowLength)) = UCase(strCNPrefixToShow)) And (UCase(Left(strGroupsAMAccountName, intPrefixToIgnoreLength)) <> UCase(strCNPrefixToIgnore)) Then
blnIsOKToAdd = True
End If
Else
blnIsOKToAdd = True
End If

If blnIsOKToAdd Then
'// It's OK to add the name, but only if it hasn't already been added
If Not dicGroups.Exists(strADObjectsAMAccountName & "\" & strGroupsAMAccountName) Then
dicGroups.Add strADObjectsAMAccountName & "\" & strGroupsAMAccountName, True
End If
End If

.MoveNext
Loop

.Close
End With

LoadGroups_tokenGroups = True

Set objRS_Groups = Nothing
End Function

Function OctetToHexStr(ByVal arrOctet)
'// Converts OctetString (byte array) to Hex string, with bytes delimited by '\' for an ADO filter

Dim intIndex

OctetToHexStr = ""

For intIndex = 1 To LenB(arrOctet)
OctetToHexStr = OctetToHexStr & "\" & Right("0" & Hex(Ascb(Midb(arrOctet, intIndex, 1))), 2)
Next
End Function

Function LoadGroups_memberOf(ByVal objPriADObject, ByVal objSubADObject, ByVal strCNPrefixToShow, ByVal strCNPrefixToIgnore)
'// Populate dictionary object with group memberships.
'// When this routine is first called, both objPriADObject and objSubADObject
'// are the same object. On recursive calls, objPriADObject still refers to the
'// object being tested, but objSubADObject will be a group object.
'// The dictionary object dicGroups keeps track of group memberships for
'// each AD object separately.
'// For each group in the MemberOf collection, the function checks to see if
'// the group is already in the dictionary object. If it is not, it adds the
'// group to the dictionary object and recursively call this subroutine again
'// to enumerate any groups the group might be a member of (nested groups).
'// It is necessary to first check if the group is already in the dictionary
'// object to prevent an infinite loop if the group nesting is "circular".
'// The MemberOf collection does not include any "primary" groups.

Dim colGroups
Dim objGroup
Dim intIndex
Dim blnReturn_LoadGroups_memberOf
Dim strPriADObjectsAMAccountName
Dim strGroupsAMAccountName

intPrefixToShowLength = Len(strCNPrefixToShow)
intPrefixToIgnoreLength = Len(strCNPrefixToIgnore)

LoadGroups_memberOf = False

strPriADObjectsAMAccountName = objPriADObject.sAMAccountName
strMsg = ""
strMsg = strMsg & "Get 'sAMAccountName' method for objPriADObject"
Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

colGroups = objSubADObject.memberOf
strMsg = ""
strMsg = strMsg & "Get 'memberOf' method for objPriADObject"
Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

If IsEmpty(colGroups) = True Then
Exit Function
End If

If TypeName(colGroups) = "String" Then
'// Escape any forward slash characters, "/", with the backslash escape character.
'// All other characters that should be escaped are.
colGroups = Replace(colGroups, "/", "\/")

Set objGroup = GetObject("LDAP://" & colGroups)
strGroupsAMAccountName = objGroup.sAMAccountName

If Not dicGroups.Exists(strPriADObjectsAMAccountName & "\" & strGroupsAMAccountName) Then
dicGroups.Add strPriADObjectsAMAccountName & "\" & strGroupsAMAccountName, True
blnReturn_LoadGroups_memberOf = LoadGroups_memberOf(objPriADObject, objGroup)
End If

Set objGroup = Nothing

Exit Function
End If

For intIndex = 0 To UBound(colGroups)
'// Escape any forward slash characters, "/", with the backslash escape character.
'// All other characters that should be escaped are.
colGroups(intIndex) = Replace(colGroups(intIndex), "/", "\/")

Set objGroup = GetObject("LDAP://" & colGroups(intIndex))
strGroupsAMAccountName = objGroup.sAMAccountName
strMsg = ""
strMsg = strMsg & "Get 'sAMAccountName' method for objGroup"
Call CheckError(strMsg, strMsg, "", blnShowMessageIfSuccessful, blnUseInstallerErrorMessage, blnErrorIsFatal)
If blnErrorIsFatal Then
On Error Goto 0
Exit Function
End If

If Not dicGroups.Exists(strPriADObjectsAMAccountName & "\" & strGroupsAMAccountName) Then
dicGroups.Add strPriADObjectsAMAccountName & "\" & strGroupsAMAccountName, True
blnReturn_LoadGroups_memberOf = LoadGroups_memberOf(objPriADObject, objGroup)
End If
Next

LoadGroups_memberOf = True

Set objGroup = Nothing
End Function

Sub CheckError(ByVal strErrSource, ByVal strInfo, ByVal strIgnoreList, ByVal blnShowSuccess, ByVal blnUseInstallerError, ByRef blnIsFatal)
Dim strMessage
Dim intErrNbr
Dim strErrDescription
Dim arrIgnoreList
Dim intIgnoreIndex
Dim blnIgnoring

blnIgnoring = False
blnIsFatal = False

blnIsError = False

With Err
.Source = strErrSource

If .Number > 2147942400 Then
'// The start of hex error numbers, 80070000, is 2147942400 in decimal
intErrNbr = CStr(Hex(.Number))
Else
intErrNbr = CStr(.Number)
End If

strErrDescription = .Description

If .Number = 0 Then
If blnShowSuccess Then
Call Say(strInfo & " succeeded." & vbCRLF, blnUseLog)
End If
.Clear
Exit Sub
End If

blnIsError = True

If Len(strErrDescription) > 0 Then
'// Now we find that MS can't even be bothered to end their sentences with full stops!
If Right(strErrDescription, 1) <> "." Then
strErrDescription = strErrDescription & ". "
End If
End If

strMessage = ""

If blnUseInstallerError Then
If Not objInstaller Is Nothing Then
Set objInstallerError = objInstaller.LastErrorRecord
If Not objInstallerError Is Nothing Then
strMessage = strMessage & vbCRLF & objInstallerError.FormatText
End If
End If
Else
strMessage = strMessage & "Error: " & intErrNbr & vbCRLF

Select Case intErrNbr
Case "80072030"
.Description = "There is no such object on the server."
Case "80071392"
.Description = "The object already exists."
Case Else
If .Number > 2147942400 Then
blnResult = LookUpError(intErrNbr, strErrDescription)
End If

.Description = strErrDescription
End Select

If Len(.Description) > 0 Then
strMessage = strMessage & "Description: " & .Description & vbCRLF
End If

If .Source <> "CheckError" Then
strMessage = strMessage & "Source: " & .Source & vbCRLF
End If

'// We may want to ignore certain errors
If Len(strIgnoreList) > 0 Then
arrIgnoreList = Split(strIgnoreList, ",")
For intIgnoreIndex = 0 To UBound(arrIgnoreList)
If .Number = CLng(arrIgnoreList(intIgnoreIndex)) Then
blnIgnoring = True
.Clear
strMessage = strMessage & vbTAB & "** Script is set to IGNORE this error **" & vbCRLF
Exit For
End If
Next
End If

If Not blnIgnoring Then
'// We don't to repeat information
If Len(.Source) = 0 Then
If Len(strInfo) > 0 Then
strMessage = strMessage & strInfo & vbCRLF
End If
End If
End If

If Not blnIgnoring Then
.Source = "CheckError"
blnIsFatal = True
End If

If blnIsFatal Then
strMessage = vbCRLF & vbCRLF & vbTAB & vbTAB & "Fatal " & strMessage
End If

.Clear

Call Say(strMessage & vbCRLF, blnUseLog)
End If
End With
End Sub

Function LookUpError(ByVal strErrorNbr, ByRef strErr)

LookUpError = False

With dicError
If .Exists(strErrorNbr) Then
strErr = ""
strErr = strErr & strErrorNbr & ": "
strErr = strErr & .Item(strErrorNbr)(ERR_CLASS)
strErr = strErr & " (" & .Item(strErrorNbr)(ERR_INFO) & ") "
strErr = strErr & .Item(strErrorNbr)(ERR_DESCRIPTION)
LookUpError = True
Else
strErr = strErrorNbr & ": Description not found"
End If
End With

End Function

Sub SetupErrorDictionary
With dicError
.Add "0", Array("Global Error", "OPERATION_SUCCEEDED", "Operation succeeded.")

'// Generic COM errors
.Add "80004004", Array("Generic COM Error", "E_ABORT","Operation aborted.")
.Add "80004005", Array("Generic COM Error", "E_FAIL","Unspecified error.")
.Add "80004002", Array("Generic COM Error", "E_NOINTERFACE","Interface not supported.")
.Add "80004001", Array("Generic COM Error", "E_NOTIMPL","Not implemented.")
.Add "80004003", Array("Generic COM Error", "E_POINTER","Invalid pointer.")
.Add "8000FFFF", Array("Generic COM Error", "E_UNEXPECTED","Catastrophic failure.")

'// Generic ADSI error codes
.Add "00005011", Array("Generic ADSI error", "S_ADS_ERRORSOCCURRED", "During a query, one or more errors occurred. Verify that the search preference can be legally set and, if so, that it is properly set.")
.Add "00005012", Array("Generic ADSI error", "S_ADS_NOMORE_ROWS", "The search operation has reached the last row. Move on to the rest of the program.")
.Add "00005013", Array("Generic ADSI error", "S_ADS_NOMORE_COLUMNS", "The search operation has reached the last column for the current row. Move on to next row.")
.Add "80005000", Array("Generic ADSI error", "E_ADS_BAD_PATHNAME", "An invalid ADSI pathname was passed. Verify that the object exists on the directory server and check for typographic errors of the path.")
.Add "80005001", Array("Generic ADSI error", "E_ADS_INVALID_DOMAIN_OBJECT", "An unknown ADSI domain object was requested. Verify the path of the domain object.")
.Add "80005002", Array("Generic ADSI error", "E_ADS_INVALID_USER_OBJECT", "An unknown ADSI user object was requested. Verify the existence of the user object, check for typos of the path and the user access rights.")
.Add "80005003", Array("Generic ADSI error", "E_ADS_INVALID_COMPUTER_OBJECT", "An unknown ADSI computer object was requested. Verify the existence of the computer object, check for typos of the path and the computer access rights.")
.Add "80005004", Array("Generic ADSI error", "E_ADS_UNKNOWN_OBJECT", "An unknown ADSI object was requested. Verify the name of and the access rights to the object.")
.Add "80005005", Array("Generic ADSI error", "E_ADS_PROPERTY_NOT_SET", "The specified ADSI property was not set.")
.Add "80005006", Array("Generic ADSI error", "E_ADS_PROPERTY_NOT_SUPPORTED", "The specified ADSI property is not supported. Verify that the correct property is set.")
.Add "80005007", Array("Generic ADSI error", "E_ADS_PROPERTY_INVALID", "The specified ADSI property is invalid Verify the parameters passed to the method call.")
.Add "80005008", Array("Generic ADSI error", "E_ADS_BAD_PARAMETER", "One or more input parameters are invalid.")
.Add "80005009", Array("Generic ADSI error", "E_ADS_OBJECT_UNBOUND", "The specified ADSI object is not bound to a remote resource. Call GetInfo on a newly created object after SetInfo has been called.")
.Add "8000500A", Array("Generic ADSI error", "E_ADS_PROPERTY_NOT_MODIFIED", "The specified ADSI object has not been modified.")
.Add "8000500B", Array("Generic ADSI error", "E_ADS_PROPERTY_MODIFIED", "The specified ADSI object has been modified.")
.Add "8000500C", Array("Generic ADSI error", "E_ADS_CANT_CONVERT_DATATYPE", "The data type cannot be converted to/from a native DS data type. Verify that the correct data type is used and/or that there is sufficient schema data available to perform data type conversion.")
.Add "8000500D", Array("Generic ADSI error", "E_ADS_PROPERTY_NOT_FOUND", "The property cannot be found in the cache. Verify that GetInfo has been called implicitly or explicitly. If the attribute is an operational attribute, it must be explicitly retrieved with GetInfoEx instead of GetInfo. If the problem persists, the property has not been set on the server.")
.Add "8000500E", Array("Generic ADSI error", "E_ADS_OBJECT_EXISTS", "The ADSI object exists. Use a different name to create the object.")
.Add "8000500F", Array("Generic ADSI error", "E_ADS_SCHEMA_VIOLATION", "The attempted action violates the directory service schema rules.")
.Add "80005010", Array("Generic ADSI error", "E_ADS_COLUMN_NOT_SET", "The specified column in the ADSI was not set.")
.Add "80005014", Array("Generic ADSI error", "E_ADS_INVALID_FILTER", "The specified search filter is invalid. Use the correct format of the filter accepted by the directory server.")

'// Win32 error codes for ADSI
.Add "80070002", Array("Win32 error for ADSI", "LDAP_NO_SUCH_OBJECT ERROR_FILE_NOT_FOUND", "Object does not exist.")
.Add "80070037", Array("Win32 error for ADSI", "LDAP_UNAVAILABLE ERROR_DEV_NOT_EXIST", "Server is not available.")
.Add "8007003A", Array("Win32 error for ADSI", "LDAP_SERVER_DOWN ERROR_BAD_NET_RESP", "Cannot contact the LDAP server.")
.Add "8007003B", Array("Win32 error for ADSI", "LDAP_ENCODING_ERROR ERROR_UNEXP_NET_ERR", "Encoding/decoding error occurred.")
.Add "80070044", Array("Win32 error for ADSI", "LDAP_ADMIN_LIMIT_EXCEEDED ERROR_TOO_MANY_NAMES", "Exceeded administration limit on the server.")
.Add "80070056", Array("Win32 error for ADSI", "LDAP_INVALID_CREDENTIALS ERROR_INVALID_PASSWORD", "Invalid credential.")
.Add "80070057", Array("Win32 error for ADSI", "LDAP_INVALID_DN_SYNTAX ERROR_INVALID_PARAMETER", "Distinguished name has an invalid syntax.")
.Add "8007006E", Array("Win32 error for ADSI", "LDAP_OPERATIONS_ERROR ERROR_OPEN_FAILED", "Operation error occurred.")
.Add "8007007A", Array("Win32 error for ADSI", "LDAP_RESULTS_TOO_LARGE ERROR_INSUFFICIENT_BUFFER", "Results set is too large.")
.Add "8007007B", Array("Win32 error for ADSI", "LDAP_INVALID_SYNTAX ERROR_INVALID_NAME", "Invalid syntax.")
.Add "8007007C", Array("Win32 error for ADSI", "LDAP_PROTOCOL_ERROR ERROR_INVALID_LEVEL", "Protocol error.")
.Add "800700B7", Array("Win32 error for ADSI", "LDAP_ALREADY_EXISTS ERROR_ALREADY_EXISTS", "Object already exists.")
.Add "800700EA", Array("Win32 error for ADSI", "LDAP_PARTIAL_RESULTS ERROR_MORE_DATA", "Partial results and referrals received.")
.Add "800703EB", Array("Win32 error for ADSI", "LDAP_UNWILLING_TO_PERFORM ERROR_CAN_NOT_COMPLETE", "Server cannot perform operation.")
.Add "8007041D", Array("Win32 error for ADSI", "LDAP_TIMEOUT ERROR_SERVICE_REQUEST_TIMEOUT", "Search timed out.")
.Add "800704B8", Array("Win32 error for ADSI", "LDAP_INAPPROPRIATE_MATCHING ERROR_EXTENDED_ERROR", "There was an inappropriate matching.")
.Add "800704C7", Array("Win32 error for ADSI", "LDAP_USER_CANCELLED ERROR_CANCELLED", "User has cancelled the operation.")
.Add "80070718", Array("Win32 error for ADSI", "LDAP_TIMELIMIT_EXCEEDED ERROR_NOT_ENOUGH_QUOTA", "Exceeded time or size limit.")

'// Win32 error codes
.Add "80070005", Array("Win32 error", "LDAP_INSUFFICIENT_RIGHTS ERROR_ACCESS_DENIED", "User has insufficient access rights.")
.Add "80070008", Array("Win32 error", "LDAP_NO_MEMORY ERROR_NOT_ENOUGH_MEMORY", "System is out of memory.")
.Add "8007001F", Array("Win32 error", "LDAP_OTHER ERROR_GEN_FAILURE", "Unknown error.")
.Add "800704C9", Array("Win32 error", "LDAP_CONNECT_ERROR ERROR_CONNECTION_REFUSED", "Cannot establish the connection.")
.Add "8007052E", Array("Win32 error", "LDAP_INVALID_CREDENTIALS ERROR_LOGON_FAILURE", "Supplied credentials are invalid.")
.Add "800705B4", Array("Win32 error", "LDAP_TIMEOUT ERROR_TIMEOUT", "Search timed out.")
.Add "80071392", Array("Win32 error", "LDAP_ALREADY_EXISTS ERROR_OBJECT_ALREADY_EXISTS", "Object already exists.")
.Add "8007200A", Array("Win32 error", "LDAP_NO_SUCH_ATTRIBUTE ERROR_DS_NO_ATTRIBUTE_OR_VALUE", "Requested attribute does not exist.")
.Add "8007200B", Array("Win32 error", "LDAP_INVALID_SYNTAX ERROR_DS_INVALID_ATTRIBUTE_SYNTAX", "Syntax is invalid.")
.Add "8007200C", Array("Win32 error", "LDAP_UNDEFINED_TYPE ERROR_DS_ATTRIBUTE_TYPE_UNDEFINED", "The attribute type specified to the directory service is not defined.")
.Add "8007200D", Array("Win32 error", "LDAP_ATTRIBUTE_OR_VALUE_EXISTS ERROR_DS_ATTRIBUTE_OR_VALUE_EXISTS", "Attribute already exists or the value has been assigned.")
.Add "8007200E", Array("Win32 error", "LDAP_BUSY ERROR_DS_BUSY", "Server is busy.")
.Add "8007200F", Array("Win32 error", "LDAP_UNAVAILABLE ERROR_DS_UNAVAILABLE", "Server is not available.")
.Add "80072014", Array("Win32 error", "LDAP_OBJECT_CLASS_VIOLATION ERROR_DS_OBJ_CLASS_VIOLATION", "Object class violation.")
.Add "80072015", Array("Win32 error", "LDAP_NOT_ALLOWED_ON_NONLEAF ERROR_DS_CANT_ON_NON_LEAF", "Operation is not allowed on a non-leaf object.")
.Add "80072016", Array("Win32 error", "LDAP_NOT_ALLOWED_ON_RDN ERROR_DS_CANT_ON_RDN", "Operation is not allowed on an RDN.")
.Add "80072017", Array("Win32 error", "LDAP_NO_OBJECT_CLASS_MODS ERROR_DS_CANT_MOD_OBJ_CLASS", "Cannot modify object class.")
.Add "80072020", Array("Win32 error", "LDAP_OPERATIONS_ERROR ERROR_DS_OPERATIONS_ERROR", "Operation error occurred.")
.Add "80072021", Array("Win32 error", "LDAP_PROTOCOL_ERROR ERROR_DS_PROTOCOL_ERROR", "Protocol error occurred.")
.Add "80072022", Array("Win32 error", "LDAP_TIMELIMIT_EXCEEDED ERROR_DS_TIMELIMIT_EXCEEDED", "Exceeded time limit.")
.Add "80072023", Array("Win32 error", "LDAP_SIZELIMIT_EXCEEDED ERROR_DS_SIZELIMIT_EXCEEDED", "Exceeded size limit.")
.Add "80072024", Array("Win32 error", "LDAP_ADMIN_LIMIT_EXCEEDED ERROR_DS_ADMIN_LIMIT_EXCEEDED", "Exceeded administration limit on the server.")
.Add "80072025", Array("Win32 error", "LDAP_COMPARE_FALSE ERROR_DS_COMPARE_FALSE", "Compare yielded FALSE.")
.Add "80072026", Array("Win32 error", "LDAP_COMPARE_TRUE ERROR_DS_COMPARE_TRUE", "Compare yielded TRUE.")
.Add "80072027", Array("Win32 error", "LDAP_AUTH_METHOD_NOT_SUPPORTED ERROR_DS_AUTH_METHOD_NOT_SUPPORTED", "The authentication method is not supported.")
.Add "80072028", Array("Win32 error", "LDAP_STRONG_AUTH_REQUIRED", "ERROR_DS_STRONG_AUTH_REQUIRED", "Strong authentication is required.")
.Add "80072029", Array("Win32 error", "LDAP_INAPPROPRIATE_AUTH", "ERROR_DS_INAPPROPRIATE_AUTH", "Authentication is inappropriate.")
.Add "8007202A", Array("Win32 error", "LDAP_AUTH_UNKNOWN", "ERROR_DS_AUTH_UNKNOWN", "Unknown authentication error occurred.")
.Add "8007202B", Array("Win32 error", "LDAP_REFERRAL ERROR_DS_REFERRAL Cannot resolve referral.")
.Add "8007202C", Array("Win32 error", "LDAP_UNAVAILABLE_CRIT_EXTENSION ERROR_DS_UNAVAILABLE_CRIT_EXTENSION Critical extension is unavailable.")
.Add "8007202D", Array("Win32 error", "LDAP_CONFIDENTIALITY_REQUIRED ERROR_DS_CONFIDENTIALITY_REQUIRED", "Confidentiality is required.")
.Add "8007202E", Array("Win32 error", "LDAP_INAPPROPRIATE_MATCHING ERROR_DS_INAPPROPRIATE_MATCHING", "There was an inappropriate matching.")
.Add "8007202F", Array("Win32 error", "LDAP_CONSTRAINT_VIOLATION ERROR_DS_CONSTRAINT_VIOLATION", "There was a constrain violation.")
.Add "80072030", Array("Win32 error", "LDAP_NO_SUCH_OBJECT ERROR_DS_NO_SUCH_OBJECT", "Object does not exist.")
.Add "80072031", Array("Win32 error", "LDAP_ALIAS_PROBLEM ERROR_DS_ALIAS_PROBLEM", "Alias is invalid.")
.Add "80072032", Array("Win32 error", "LDAP_INVALID_DN_SYNTAX ERROR_DS_INVALID_DN_SYNTAX", "Distinguished name has an invalid syntax.")
.Add "80072033", Array("Win32 error", "LDAP_IS_LEAF ERROR_DS_IS_LEAF", "The object is a leaf.")
.Add "80072034", Array("Win32 error", "LDAP_ALIAS_DEREF_PROBLEM ERROR_DS_ALIAS_DEREF_PROBLEM", "Cannot de-reference the alias.")
.Add "80072035", Array("Win32 error", "LDAP_UNWILLING_TO_PERFORM ERROR_DS_UNWILLING_TO_PERFORM", "Server unwilling to perform operation.")
.Add "80072036", Array("Win32 error", "LDAP_LOOP_DETECT ERROR_DS_LOOP_DETECT", "Loop was detected.")
.Add "80072037", Array("Win32 error", "LDAP_NAMING_VIOLATION ERROR_DS_NAMING_VIOLATION", "There was a naming violation.")
.Add "80072038", Array("Win32 error", "LDAP_RESULTS_TOO_LARGE ERROR_DS_OBJECT_RESULTS_TOO_LARGE", "Results set is too large.")
.Add "80072039", Array("Win32 error", "LDAP_AFFECTS_MULTIPLE_DSAS ERROR_DS_AFFECTS_MULTIPLE_DSAS", "Multiple directory service agents are affected.")
.Add "8007203A", Array("Win32 error", "LDAP_SERVER_DOWN ERROR_DS_SERVER_DOWN", "Cannot contact the LDAP server.")
.Add "8007203B", Array("Win32 error", "LDAP_LOCAL_ERROR ERROR_DS_LOCAL_ERROR", "Local error occurred.")
.Add "8007203C", Array("Win32 error", "LDAP_ENCODING_ERROR ERROR_DS_ENCODING_ERROR", "Encoding error occurred.")
.Add "8007203D", Array("Win32 error", "LDAP_DECODING_ERROR ERROR_DS_DECODING_ERROR", "Decoding error occurred.")
.Add "8007203E", Array("Win32 error", "LDAP_FILTER_ERROR ERROR_DS_FILTER_UNKNOWN", "The search filter is bad.")
.Add "8007203F", Array("Win32 error", "LDAP_PARAM_ERROR ERROR_DS_PARAM_ERROR", "A bad parameter was passed to a function.")
.Add "80072040", Array("Win32 error", "LDAP_NOT_SUPPORTED ERROR_DS_NOT_SUPPORTED", "Feature not supported.")
.Add "80072041", Array("Win32 error", "LDAP_NO_RESULTS_RETURNED ERROR_DS_NO_RESULTS_RETURNED", "Results are not returned.")
.Add "80072042", Array("Win32 error", "LDAP_CONTROL_NOT_FOUND ERROR_DS_CONTROL_NOT_FOUND", "Control was not found.")
.Add "80072043", Array("Win32 error", "LDAP_CLIENT_LOOP ERROR_DS_CLIENT_LOOP", "Client loop was detected.")
.Add "80072044", Array("Win32 error", "LDAP_REFERRAL_LIMIT_EXCEEDED ERROR_DS_REFERRAL_LIMIT_EXCEEDED", "Exceeded referral limit.")
End With
End Sub
Sub Say(ByVal strMsgText, ByVal blnUseLog)

If blnIsCustomAction Then
Dim objMSIRecord
Const msiMessageTypeFatalExit = &H00000000 '// Premature termination, possibly fatal out of memory.
Const msiMessageTypeError = &H01000000 '// Formatted error message, [1] is message number in Error table.
Const msiMessageTypeWarning = &H02000000 '// Formatted warning message, [1] is message number in Error table.
Const msiMessageTypeUser = &H03000000 '// User request message, [1] is message number in Error table.
Const msiMessageTypeInfo = &H04000000 '// Informative message for log, not to be displayed.
Const msiMessageTypeFilesInUse = &H05000000 '// List of files in use that need to be replaced.
Const msiMessageTypeResolveSource = &H06000000 '// Request to determine a valid source location.
Const msiMessageTypeOutOfDiskSpace = &H07000000 '// Insufficient disk space message.
Const msiMessageTypeActionStart = &H08000000 '// Start of action,
'// [1] action name,
'// [2] description,
'// [3] template for ACTIONDATA messages.
Const msiMessageTypeActionData = &H09000000 '// Action data. Record fields correspond to the template of ACTIONSTART message.
Const msiMessageTypeProgress = &H0A000000 '// Progress bar information. See the description of record fields below.
Const msiMessageTypeCommonData = &H0B000000 '// To enable the Cancel button set [1] to 2 and [2] to 1.
'// To disable the Cancel button set [1] to 2 and [2] to 0

Set objMSIRecord = Session.Installer.CreateRecord(0)
objMSIRecord.StringData(0) = strMsgText
Session.Message msiMessageTypeError, objMSIRecord
Set objMSIRecord = Nothing
Else
'MsgBox strMsgText
span_QuickMessageArea.InnerText = strMsgText

'// Triggers screen updates in an HTA
objWSHShell.Run "%comspec% /c echo something & exit", 0, True

If blnUseLog Then
If Len(strLogText) > 0 Then
strLogText = strLogText & vbCRLF & strMsgText
Else
strLogText = strMsgText
End If
End If
End If

strMsgText = ""
End Sub

VBScab - can you use the 'code' tags in future? [;)] Ha ha....

LOL. In my haste to answer my phone, I omitted the closing tag. Thanks, Cap'n.

Thank you VBScab,

I will try this today and will let you know how it went.

Thank you mate