' OFFICE2007_DEPLOY.VBS
' See http://www.officesharepointpro.com/content/1793/Automating-Office-2007-Deployment.aspx
' For details

'=====================================================================


'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.1
'
' NAME: OFFICE2007_DEPLOY.VBS
' AUTHOR: Dan Holme , Intelliem
' DATE  : 5/18/2007
'
' COMMENT: Used to deploy Office 2007
'           Or to perform any other command on systems
'           Be sure to change elements in the CONFIGURATION BLOCK below
'
' FOR DETAILS
'    
http://www.officesharepointpro.com/content/
'     1793/Automating-Office-2007-Deployment.aspx
'

================================================================

Option Explicit
'================================================================


' BEGIN CONFIGURATION BLOCK

' DOMAIN
Dim sDomainDNS, sDomainDN
sDomainDNS = "windomain.com"
sDomainDN = "dc=windomain,dc=com"
' DATABASE DEFINITION: where our script will find its data store
' The database is used to log the results of the script
' Because systems don't yet have Office 2007,
' use a downlevel database format (xls/mdb)
Dim sFile, sTable
sFile = "\\server01.windomain.com\configmgt\SystemConfigurationDB.xls"
sTable = "Sheet1" ' Name of Excel sheet or Access table
Dim sComputerNameField, sActionField, sStatusField, sDateField, sNotesField
' Data table (e.g. Excel worksheet) consists of fields/columns
' labeled as defined below. 
' The items on the right side of the equals sign
' should be the labels in the first row of the worksheet
sComputerNameField = "ComputerName"
sActionField = "Action"
sStatusField = "Status"
sDateField = "Date"
sNotesField = "Notes"
Dim sCommand
' COMMAND to run Office 2007 installation
sCommand = "\\windomain.com\software\office\setup.exe"
Dim sAction
' ACTION that will be logged in the ACTION column of the log
sAction = "Office 2007 Deployment"
Dim sStagingGroup, sSuccessGroup, sErrorGroup
' GROUPS that manage this change
' Important: These groups must have the access control entry
'     SELF::Allow::Write::Members
' Group that computer/user is in BEFORE this script is run
sStagingGroup = "CCM_Office 2007 Deploy"
' Group that this computer/user is moved to based on success
sSuccessGroup = "APP_Office 2007"
sErrorGroup = "ALERT_Office 2007 Deploy"
' END CONFIGURATION BLOCK
'================================================================

' Data ADO enums
Const adStateClosed = 0
Const adOpenStatic = 3
Const adOpenDynamic = 2
Const adLockOptimistic = 3
Const adUseClient = 3
Dim retVal
' Perform logic to translate configuration to data table identity
Dim sFileType
Dim MSOfficeVersion
Call ADO_IdentifyDataType (sFile, sFileType, MSOfficeVersion)
' Initialization
Dim sComputerName
sComputerName = GetComputerName()
Dim oShell
Set oShell = CreateObject("WScript.Shell")
Dim sScriptResults
' ============================


' BEGIN CALLOUT A

' Run the command
Dim iExitCode, sStdOut, sStdErr
Call ExecuteCommand(sCommand, iExitCode, sStdOut, sStdErr)
' Interpret the results
Dim sStatus, sNotes
Select Case iExitCode
    Case 0
        sStatus = "SUCCESS"
        sNotes = ""
    Case Else
        sStatus = "ERROR"
        sNotes  = iExitCode & ": " & sStdErr
End Select
' In case there are problems logging, keep going
On Error Resume Next
Call Log_WriteCommandResults(sComputerName, sStatus, sNotes)
' END CALLOUT A
' ============================

' ============================


' BEGIN CALLOUT B
' Modify groups to reflect results
Select Case sStatus
    Case "SUCCESS"
        retVal= Group_AddMember (sSuccessGroup, sComputerName, "computer")
    Case "ERROR"
        retVal = Group_AddMember (sErrorGroup, sComputerName, "computer")
End Select
retVal = Group_RemoveMember (sStagingGroup, sComputerName, "computer")
' END CALLOUT B
'

=================================
WScript.Quit(0)

Sub ExecuteCommand(sCommand, iExitCode, sStdOut, sStdErr)
    ' Executes the command (sCommand)
    ' and returns its results in iExitCode, sStdOut and sStdErr
    Dim oExec
    ' DEBUG CODE: WScript.Echo sCommand
    On Error Resume Next
    Set oExec = oShell.Exec(sCommand)
    If Err.Number <> 0 Then ' There was actually a problem running the command itself
        iExitCode = Err.Number
        sStdErr = "Failed to run command " & sCommand & VbCrLf & Err.Description
        Exit Sub
    End if
    Do Until oExec.Status = 1
        WScript.Sleep 100
    Loop
    iExitCode = oExec.ExitCode
    sStdOut = oExec.StdOut.ReadAll
    sStdErr = oExec.StdErr.ReadAll
End Sub
Sub Log_WriteCommandResults (sComputerName, sStatus, sNotes)
    ' Write entry to Log
    ' First, connect to log. By using the sql query below, we get an empty recordset
    ' which is better for performance since we're only appending a record, anyway
    Dim rsLog ' As ADODB.Recordset
    Set rsLog = Log_Query("SELECT * FROM " & sTable & " WHERE " & sComputerNameField & "=''")
    If Not (rsLog Is Nothing) Then
    rsLog.AddNew
    rsLog.Fields(sComputerNameField) = sComputerName
    rsLog.Fields(sActionField) = sAction
    rsLog.Fields(sDateField) = Now()
    rsLog.Fields(sStatusField) = sStatus
    rsLog.Fields(sNotesField) = sNotes
    rsLog.Update
    rsLog.Close
    Set rsLog = Nothing
    End If
End Sub
Function Log_Query(sSQL)
    ' Connects to the log defined in the CONFIGURATION BLOCK above
    Dim sConnectionString ' As String
    sConnectionString = ADO_BuildConnectionString(sFileType,sFile,"","","")
    Dim oConnection ' As ADODB.Connection
    Set oConnection = ADO_DBConnection(sConnectionString)
    Dim rs ' As ADODB.Recordset
    On Error Resume Next
    Set rs = ADO_GetRecordset(sSQL, oConnection)
    If Err.Number <> vbEmpty Then
        sScriptResults = sScriptResults & ErrorHandler("Could not open log " & sFile & " with SQL " & sSQL)
        Set rs=Nothing
    Else
    Set Log_Query = rs
    End If
End Function
Sub ADO_IdentifyDataType (sFile, sFileType, MSOfficeVersion)
    ' Takes an INPUT of sFile (path/filename of an Excel or Access file)
    ' and returns  the type ("excel" or "access") and the version (2003 or 2007)
    ' to the sFileType and MSOfficeVersion variables
   
    ' Determine file type (crude: there are slicker ways)
    On Error Resume Next
    sFileType = Mid(sFile, InStrRev(sFile,".") +1)
    If Err.Number<>0 Then
        ' Error Handling
        WScript.Quit (501) ' Throw an error (I choose 501 as my standard error number)
    End If
    On Error GoTo 0
   
    sFileType = LCase(sFileType)
    Select Case sFileType
        Case "xls"
            MSOfficeVersion = 2003
            sTable = "\\[" & sTable & "$\\]" ' Must format sheet name to make data table
            sFileType = "excel"
        Case "xlsx"
            MSOfficeVersion = 2007
            sTable = "\\[" & sTable & "$\\]" ' Must format sheet name to make data table
            sFileType = "excel"
        Case "mdb"
            MSOfficeVersion = 2003
            sFileType = "access"
        Case "accdb"
            MSOfficeVersion = 2007
            sFileType = "access"
        Case Else
            ' Error Handling
            WScript.Quit (501) ' Throw an error    (I choose 501 as my standard error number)   
    End Select
End Sub
Function ADO_BuildConnectionString(ByVal sType, ByVal sFile, ByVal sDatabase, ByVal sUsername, ByVal sPassword)
    ' Returns a connection string for Access, Excel or SQL
    ' Example usage:
    '     ACCESS: sConnectionString = ADO_BuildConnectionString("access",filename,"","","")
    '    EXCEL:    sConnectionString = ADO_BuildConnectionString("excel",filename,"","","")
    Dim sProvider, sExtendedProperties
    Select Case MSOfficeVersion
        Case 2007
            sProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"
            sExtendedProperties = "Extended Properties=Excel 12.0;"
        Case Else   
            sProvider = "Provider=Microsoft.Jet.OLEDB.4.0;" ' FOR PREVIOUS VERSIONS
            sExtendedProperties = "Extended Properties=Excel 8.0;"
    End Select
    Select Case lcase(sType)
        Case "access"
            ADO_BuildConnectionString = sProvider & "Data Source=" & sFile & ";"
        Case "excel"
            ADO_BuildConnectionString = sProvider & "Data Source=" & sFile & ";" & sExtendedProperties
        Case "sql"
            ADO_BuildConnectionString = "Provider=sqloledb;server=" & sFile & ";database=" & sDatabase & ";uid=" & sUsername & ";pwd=" & sPassword & ";"
    End Select  
End Function
Function ADO_DBConnection(ByVal sConnectionString)
    ' Returns an ADODB.Connection object
    ' Example usage:
    '    Set oConnection = ADO_DBConnection(sConnectionString)
    Dim oConnection ' As ADODB.Connection
    Set oConnection = CreateObject("ADODB.Connection")
    oConnection.Open sConnectionString
    Set ADO_DBConnection = oConnection
End Function
Function ADO_GetRecordset(ByVal strSQL, ByRef oDBConnection)
    ' Returns an ADODB.Recordset object
    ' Example usage:
    '    Set rsDel = ADO_GetRecordset(sSQL, oConnection)
        Dim rs
        Set rs = CreateObject("adodb.Recordset")
        rs.CursorLocation = adUseClient
        rs.Open strSQL, oDBConnection, adOpenStatic, adLockOptimistic
        Set ADO_GetRecordset = rs
End Function
Function GetComputerName()
    Dim WshNetwork
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    GetComputerName = WshNetwork.ComputerName
End Function
Function FindObjectADsPath(sObjectClass, sUniqueID, sSearchDN, sSearchScope, sLDAPTargetDNS)
    ' Returns the full ADsPath (LDAP://...) of an object based on the unique identifier of the object
    ' Inputs:
    ' sObjectClass: The script supports: user, group, computer
    ' sUniqueID: The unique identifier for the object class.  The script supports:
    '    user: samAccountName
    '    computer: Name
    '    group: samAccountName
    ' sSearchDN: the DN within which to search (often, the DN of the domain, e.g. dc=windomain, dc=com)
    ' sSearchScope: the AD Search scope, which can be subtree or onelevel or base (subtree most common)
    ' sLDAPTargetDNS: a specific domain (DNS name) or domain controller - optional
    Dim oConnection
    Dim oRecordset
    Dim sLDAPObjectQuery
    Dim sLDAPIdentifierQuery
    Dim sLDAPQuery
    Dim sProperties
    Dim oADObject
    Dim aProperties
    Dim sProperty
    Dim sLDAPIdentifier
   
    sLDAPObjectQuery = "(objectCategory=" & sObjectClass & ")"
    ' Based on the type of object, change the identifier that is being used
    Select Case lcase(sObjectClass)
        Case "user","group"
            sLDAPIdentifier = "samAccountName"
        Case "computer"
            sLDAPIdentifier = "Name"
        Case Else
            ' Error handling code: class not yet coded
            Exit Function
    End Select
    sProperties = "ADsPath"
   
    ' Open an ADO connection using null credentials
    Set oConnection = CreateObject("ADODB.Connection")
    oConnection.Provider = "ADsDSOObject"
    On Error Resume Next
    oConnection.Open "", vbNullString, vbNullString
    If oConnection.State = adStateClosed Then
         ' Error handling code
         ' WScript.Echo "ERROR: Connection to AD failed."
         Exit Function
    End If
   
    ' Build the LDAP Query
    If sLDAPTargetDNS > "" Then
        sLDAPQuery = "<LDAP://" & sLDAPTargetDNS & "/" & sSearchDN & ">;"
    Else
        sLDAPQuery = "<LDAP://" & sSearchDN & ">;"
    End If
    sLDAPQuery = sLDAPQuery & _
        "(&" & sLDAPObjectQuery & _
        "(" & sLDAPIdentifier & "=" & sUniqueID & ")" & _
        ");" & _
        sProperties & ";" & sSearchScope
    ' Don't forget the first ampersand as the AND logic
   
    ' Retrieve the result set, close the connection, and check to make
    ' sure we received at least one result
    Set oRecordset = oConnection.Execute (sLDAPQuery)
    If oRecordset.EOF and oRecordset.BOF Then
        ' Error handling code
        ' WScript.Echo "ERROR: No objects found." & VbCrLf & sLDAPQuery & vbCrLf & VbCrLf
        FindObjectADsPath = ""
         Exit Function
    End If
   
    FindObjectADsPath = oRecordset.Fields("ADsPath")
    oRecordset.Close
    oConnection.Close
   
End Function
Function Group_AddMember (sGroupName, sMemberName, sMemberType)
    ' Adds a member to a group
    ' Inputs:
    ' sGroupName: samAccountName of the group
    ' sMemberName: samAccountName (user/group) or Name (computer) of member to add
    ' sMemberType: user, group, or computer
    ' Prerequisites: sDomainDN (the DN of the domain) and sDomainDNS (the DNS name of the domain)
    ' Dependencies: ErrorHandler and sScriptResults
   
    Dim sGroupADsPath, oGroup, sMemberADsPath, oMember
    sGroupADsPath = FindObjectADsPath("group", sGroupName, sDomainDN, "subtree", sDomainDNS)
    If sGroupADsPath = "" Then
        Group_AddMember = False
        sScriptResults = sScriptResults & "Could not find group: " & sGroupName
        Exit Function
    End If
   
    On Error Resume Next
    Set oGroup = GetObject(sGroupADsPath)
    If Err.Number <> vbEmpty Then
        Group_AddMember = False
        sScriptResults = sScriptResults & ErrorHandler ("Could not connect to group: " & sGroupName)
        Exit Function
    End If
   
    sMemberADsPath = FindObjectADsPath (sMemberType, sMemberName, sDomainDN, "subtree", sDomainDNS)
    If sMemberADsPath = "" Then
        Group_AddMember = False
        sScriptResults = sScriptResults & "Could not find " & sMemberType & ": " & sMemberName
        Exit Function
    End If
   
    oGroup.Add(sMemberADsPath)
    If Err.number <> vbEmpty Then
        Group_AddMember = False
        sScriptResults = sScriptResults & ErrorHandler ("Could not add " & sMemberType & " " & _
            sMemberName & " (" & sMemberADsPath & ") " & _
            " to group " & sGroupName & " (" & sGroupADsPath & ")")
        Exit Function
    End If
    Group_AddMember = True
   
End Function
Function Group_RemoveMember (sGroupName, sMemberName, sMemberType)
    ' Removes a member from a group
    ' Inputs:
    ' sGroupName: samAccountName of the group
    ' sMemberName: samAccountName (user/group) or Name (computer) of member to add
    ' sMemberType: user, group, or computer
    ' Prerequisites: sDomainDN (the DN of the domain) and sDomainDNS (the DNS name of the domain)
    ' Dependencies: ErrorHandler and sScriptResults
   
    Dim sGroupADsPath, oGroup, sMemberADsPath, oMember
    sGroupADsPath = FindObjectADsPath("group", sGroupName, sDomainDN, "subtree", sDomainDNS)
    If sGroupADsPath = "" Then
        Group_RemoveMember = False
        sScriptResults = sScriptResults & "Could not find group: " & sGroupName
        Exit Function
    End If
   
    On Error Resume Next
    Set oGroup = GetObject(sGroupADsPath)
    If Err.Number <> vbEmpty Then
        Group_RemoveMember = False
        sScriptResults = sScriptResults & ErrorHandler ("Could not connect to group: " & sGroupName)
        Exit Function
    End If
   
    sMemberADsPath = FindObjectADsPath (sMemberType, sMemberName, sDomainDN, "subtree", sDomainDNS)
    If sMemberADsPath = "" Then
        Group_RemoveMember = False
        sScriptResults = sScriptResults & "Could not find " & sMemberType & ": " & sMemberName
        Exit Function
    End If
   
    oGroup.Remove(sMemberADsPath)
    If Err.number <> vbEmpty Then
        Group_RemoveMember = False
        sScriptResults = sScriptResults & ErrorHandler ("Could not remove " & sMemberType & " " & _
            sMemberName & " (" & sMemberADsPath & ") " & _
            " from group " & sGroupName & " (" & sGroupADsPath & ")")
        Exit Function
    End If
    Group_RemoveMember = True
   
End Function
Function ErrorHandler( sErrorText )
    ' Returns a string describing the error and clears Err
    Dim sErrorHandler
    sErrorHandler = sErrorText & VbCrLf & _
        "Error number: " & Err.number & VbCrLf & _
        "Error Description: " & Err.Description
    Err.Clear
    ErrorHandler = sErrorHandler 
End Function