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

'=====================================================================<h4>
<a name="_br_br_VBScript_Source_File_Created_with_SAPIEN_Technologies_PrimalScript_4_1_br_br_NAME_OFFICE2007_DEPLOY_VBS_br_AUTHOR_Dan_Holme_Intelliem_br_DATE_nbsp_5_18_2007_br_br_COMMENT_Used_to_deploy_Office_2007_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_Or_to_perform_any_other_command_on_systems_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_Be_sure_to_change_elements_in_the_CONFIGURATION_BLOCK_below_br_br_FOR_DETAILS_br_nbsp_nbsp_nbsp_nbsp_a_href_content_http_www_officesharepointpro_com_content_a_br_nbsp_nbsp_nbsp_nbsp_1793_Automating_Office_2007_Deployment_aspx_br_"><br>'<br>' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.1<br>'<br>' NAME: OFFICE2007_DEPLOY.VBS<br>' AUTHOR: Dan Holme , Intelliem<br>' DATE  : 5/18/2007<br>'<br>' COMMENT: Used to deploy Office 2007<br>'           Or to perform any other command on systems<br>'           Be sure to change elements in the CONFIGURATION BLOCK below<br>'<br>' FOR DETAILS<br>'     </a><a href="/content/">http://www.officesharepointpro.com/content/</a><br>'     1793/Automating-Office-2007-Deployment.aspx<br>'</h4>================================================================<h4><a name="_pre_pre_Option_Explicit_pre_pre_"></a></h4>
Option Explicit '================================================================<h4><a name="_br_BEGIN_CONFIGURATION_BLOCK_pre_pre_DOMAIN_br_Dim_sDomainDNS_sDomainDN_br_sDomainDNS_windomain_com_br_sDomainDN_dc_windomain_dc_com_pre_pre_DATABASE_DEFINITION_where_our_script_will_find_its_data_store_br_The_database_is_used_to_log_the_results_of_the_script_br_Because_systems_don_t_yet_have_Office_2007_br_use_a_downlevel_database_format_xls_mdb_br_Dim_sFile_sTable_br_sFile_a_href_file_server01_windomain_com_configmgt_SystemConfigurationDB_xls_server01_windomain_com_configmgt_SystemConfigurationDB_xls_a_br_sTable_Sheet1_Name_of_Excel_sheet_or_Access_table_br_Dim_sComputerNameField_sActionField_sStatusField_sDateField_sNotesField_br_Data_table_e_g_Excel_worksheet_consists_of_fields_columns_br_labeled_as_defined_below_nbsp_br_The_items_on_the_right_side_of_the_equals_sign_br_should_be_the_labels_in_the_first_row_of_the_worksheet_br_sComputerNameField_ComputerName_br_sActionField_Action_br_sStatusField_Status_br_sDateField_Date_br_sNotesField_Notes_pre_pre_Dim_sCommand_br_COMMAND_to_run_Office_2007_installation_br_sCommand_a_href_file_windomain_com_software_office_setup_exe_windomain_com_software_office_setup_exe_a_pre_pre_Dim_sAction_br_ACTION_that_will_be_logged_in_the_ACTION_column_of_the_log_br_sAction_Office_2007_Deployment_pre_pre_Dim_sStagingGroup_sSuccessGroup_sErrorGroup_br_GROUPS_that_manage_this_change_br_Important_These_groups_must_have_the_access_control_entry_br_nbsp_nbsp_nbsp_nbsp_SELF_Allow_Write_Members_br_Group_that_computer_user_is_in_BEFORE_this_script_is_run_br_sStagingGroup_CCM_Office_2007_Deploy_br_Group_that_this_computer_user_is_moved_to_based_on_success_br_sSuccessGroup_APP_Office_2007_br_sErrorGroup_ALERT_Office_2007_Deploy_pre_pre_END_CONFIGURATION_BLOCK_br_"><br>' BEGIN CONFIGURATION BLOCK</a></h4> ' DOMAIN<br>Dim sDomainDNS, sDomainDN<br>sDomainDNS = "windomain.com"<br>sDomainDN = "dc=windomain,dc=com" ' DATABASE DEFINITION: where our script will find its data store<br>' The database is used to log the results of the script<br>' Because systems don't yet have Office 2007, <br>' use a downlevel database format (xls/mdb)<br>Dim sFile, sTable<br>sFile = "<a href="file://server01.windomain.com/configmgt/SystemConfigurationDB.xls">\\server01.windomain.com\configmgt\SystemConfigurationDB.xls</a>"<br>sTable = "Sheet1" ' Name of Excel sheet or Access table<br>Dim sComputerNameField, sActionField, sStatusField, sDateField, sNotesField<br>' Data table (e.g. Excel worksheet) consists of fields/columns <br>' labeled as defined below.  <br>' The items on the right side of the equals sign<br>' should be the labels in the first row of the worksheet<br>sComputerNameField = "ComputerName"<br>sActionField = "Action"<br>sStatusField = "Status"<br>sDateField = "Date"<br>sNotesField = "Notes" Dim sCommand<br>' COMMAND to run Office 2007 installation<br>sCommand = "<a href="file://windomain.com/software/office/setup.exe">\\windomain.com\software\office\setup.exe</a>" Dim sAction<br>' ACTION that will be logged in the ACTION column of the log<br>sAction = "Office 2007 Deployment" Dim sStagingGroup, sSuccessGroup, sErrorGroup<br>' GROUPS that manage this change<br>' Important: These groups must have the access control entry<br>'     SELF::Allow::Write::Members<br>' Group that computer/user is in BEFORE this script is run<br>sStagingGroup = "CCM_Office 2007 Deploy" <br>' Group that this computer/user is moved to based on success<br>sSuccessGroup = "APP_Office 2007"<br>sErrorGroup = "ALERT_Office 2007 Deploy" ' END CONFIGURATION BLOCK<br>'================================================================<h4><a name="_pre_pre_Data_ADO_enums_br_Const_adStateClosed_0_br_Const_adOpenStatic_3_br_Const_adOpenDynamic_2_br_Const_adLockOptimistic_3_br_Const_adUseClient_3_br_Dim_retVal_pre_pre_Perform_logic_to_translate_configuration_to_data_table_identity_br_Dim_sFileType_br_Dim_MSOfficeVersion_br_Call_ADO_IdentifyDataType_sFile_sFileType_MSOfficeVersion_pre_pre_Initialization_br_Dim_sComputerName_br_sComputerName_GetComputerName_br_Dim_oShell_br_Set_oShell_CreateObject_WScript_Shell_br_Dim_sScriptResults_pre_pre_"></a></h4> ' Data ADO enums<br>Const adStateClosed = 0<br>Const adOpenStatic = 3<br>Const adOpenDynamic = 2<br>Const adLockOptimistic = 3<br>Const adUseClient = 3<br>Dim retVal ' Perform logic to translate configuration to data table identity<br>Dim sFileType<br>Dim MSOfficeVersion<br>Call ADO_IdentifyDataType (sFile, sFileType, MSOfficeVersion) ' Initialization<br>Dim sComputerName<br>sComputerName = GetComputerName()<br>Dim oShell<br>Set oShell = CreateObject("WScript.Shell")<br>Dim sScriptResults ' ============================<h4><a name="_br_BEGIN_CALLOUT_A_pre_pre_Run_the_command_br_Dim_iExitCode_sStdOut_sStdErr_br_Call_ExecuteCommand_sCommand_iExitCode_sStdOut_sStdErr_pre_pre_Interpret_the_results_br_Dim_sStatus_sNotes_br_Select_Case_iExitCode_br_nbsp_nbsp_nbsp_Case_0_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_sStatus_SUCCESS_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_sNotes_br_nbsp_nbsp_nbsp_Case_Else_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_sStatus_ERROR_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_sNotes_nbsp_iExitCode_amp_amp_sStdErr_br_End_Select_br_In_case_there_are_problems_logging_keep_going_br_On_Error_Resume_Next_br_Call_Log_WriteCommandResults_sComputerName_sStatus_sNotes_br_END_CALLOUT_A_br_"><br>' BEGIN CALLOUT A</a></h4> ' Run the command<br>Dim iExitCode, sStdOut, sStdErr<br>Call ExecuteCommand(sCommand, iExitCode, sStdOut, sStdErr) ' Interpret the results<br>Dim sStatus, sNotes<br>Select Case iExitCode<br>    Case 0<br>        sStatus = "SUCCESS"<br>        sNotes = ""<br>    Case Else<br>        sStatus = "ERROR"<br>        sNotes  = iExitCode & ": " & sStdErr<br>End Select<br>' In case there are problems logging, keep going<br>On Error Resume Next<br>Call Log_WriteCommandResults(sComputerName, sStatus, sNotes)<br>' END CALLOUT A<br>' ============================<h4><a name="_pre_pre_"></a></h4> ' ============================<h4><a name="_br_BEGIN_CALLOUT_B_br_Modify_groups_to_reflect_results_br_Select_Case_sStatus_br_nbsp_nbsp_nbsp_Case_SUCCESS_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_retVal_Group_AddMember_sSuccessGroup_sComputerName_computer_br_nbsp_nbsp_nbsp_Case_ERROR_br_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_nbsp_retVal_Group_AddMember_sErrorGroup_sComputerName_computer_br_End_Select_br_retVal_Group_RemoveMember_sStagingGroup_sComputerName_computer_br_END_CALLOUT_B_br_"><br>' BEGIN CALLOUT B<br>' Modify groups to reflect results<br>Select Case sStatus<br>    Case "SUCCESS"<br>        retVal= Group_AddMember (sSuccessGroup, sComputerName, "computer")<br>    Case "ERROR"<br>        retVal = Group_AddMember (sErrorGroup, sComputerName, "computer")<br>End Select<br>retVal = Group_RemoveMember (sStagingGroup, sComputerName, "computer")<br>' END CALLOUT B<br>' </a></h4>================================= WScript.Quit(0) <br>Sub ExecuteCommand(sCommand, iExitCode, sStdOut, sStdErr)<br>    ' Executes the command (sCommand)<br>    ' and returns its results in iExitCode, sStdOut and sStdErr<br>    Dim oExec<br>    ' DEBUG CODE: WScript.Echo sCommand<br>    On Error Resume Next<br>    Set oExec = oShell.Exec(sCommand)<br>    If Err.Number <> 0 Then ' There was actually a problem running the command itself<br>        iExitCode = Err.Number<br>        sStdErr = "Failed to run command " & sCommand & VbCrLf & Err.Description<br>        Exit Sub<br>    End if<br>    Do Until oExec.Status = 1<br>        WScript.Sleep 100<br>    Loop<br>    iExitCode = oExec.ExitCode<br>    sStdOut = oExec.StdOut.ReadAll<br>    sStdErr = oExec.StdErr.ReadAll<br>End Sub Sub Log_WriteCommandResults (sComputerName, sStatus, sNotes)<br>    ' Write entry to Log<br>    ' First, connect to log. By using the sql query below, we get an empty recordset<br>    ' which is better for performance since we're only appending a record, anyway<br>    Dim rsLog ' As ADODB.Recordset<br>    Set rsLog = Log_Query("SELECT * FROM " & sTable & " WHERE " & sComputerNameField & "=''")<br>    If Not (rsLog Is Nothing) Then<br>    rsLog.AddNew<br>    rsLog.Fields(sComputerNameField) = sComputerName<br>    rsLog.Fields(sActionField) = sAction<br>    rsLog.Fields(sDateField) = Now()<br>    rsLog.Fields(sStatusField) = sStatus<br>    rsLog.Fields(sNotesField) = sNotes<br>    rsLog.Update<br>    rsLog.Close<br>    Set rsLog = Nothing<br>    End If<br>End Sub Function Log_Query(sSQL)<br>    ' Connects to the log defined in the CONFIGURATION BLOCK above<br>    Dim sConnectionString ' As String<br>    sConnectionString = ADO_BuildConnectionString(sFileType,sFile,"","","")<br>    Dim oConnection ' As ADODB.Connection<br>    Set oConnection = ADO_DBConnection(sConnectionString)<br>    Dim rs ' As ADODB.Recordset<br>    On Error Resume Next<br>    Set rs = ADO_GetRecordset(sSQL, oConnection)<br>    If Err.Number <> vbEmpty Then<br>        sScriptResults = sScriptResults & ErrorHandler("Could not open log " & sFile & " with SQL " & sSQL)<br>        Set rs=Nothing<br>    Else<br>    Set Log_Query = rs<br>    End If<br>End Function Sub ADO_IdentifyDataType (sFile, sFileType, MSOfficeVersion)<br>    ' Takes an INPUT of sFile (path/filename of an Excel or Access file)<br>    ' and returns  the type ("excel" or "access") and the version (2003 or 2007)<br>    ' to the sFileType and MSOfficeVersion variables<br>    <br>    ' Determine file type (crude: there are slicker ways)<br>    On Error Resume Next<br>    sFileType = Mid(sFile, InStrRev(sFile,".") +1)<br>    If Err.Number<>0 Then<br>        ' Error Handling<br>        WScript.Quit (501) ' Throw an error (I choose 501 as my standard error number)<br>    End If<br>    On Error GoTo 0<br>    <br>    sFileType = LCase(sFileType)<br>    Select Case sFileType<br>        Case "xls"<br>            MSOfficeVersion = 2003<br>            sTable = "\\[" & sTable & "$\\]" ' Must format sheet name to make data table<br>            sFileType = "excel"<br>        Case "xlsx"<br>            MSOfficeVersion = 2007<br>            sTable = "\\[" & sTable & "$\\]" ' Must format sheet name to make data table<br>            sFileType = "excel"<br>        Case "mdb"<br>            MSOfficeVersion = 2003<br>            sFileType = "access"<br>        Case "accdb"<br>            MSOfficeVersion = 2007<br>            sFileType = "access"<br>        Case Else<br>            ' Error Handling<br>            WScript.Quit (501) ' Throw an error    (I choose 501 as my standard error number)    <br>    End Select<br>End Sub Function ADO_BuildConnectionString(ByVal sType, ByVal sFile, ByVal sDatabase, ByVal sUsername, ByVal sPassword)<br>    ' Returns a connection string for Access, Excel or SQL<br>    ' Example usage:<br>    '     ACCESS: sConnectionString = ADO_BuildConnectionString("access",filename,"","","")<br>    '    EXCEL:    sConnectionString = ADO_BuildConnectionString("excel",filename,"","","")<br>    Dim sProvider, sExtendedProperties<br>    Select Case MSOfficeVersion<br>        Case 2007<br>            sProvider = "Provider=Microsoft.ACE.OLEDB.12.0;"<br>            sExtendedProperties = "Extended Properties=Excel 12.0;"<br>        Case Else    <br>            sProvider = "Provider=Microsoft.Jet.OLEDB.4.0;" ' FOR PREVIOUS VERSIONS<br>            sExtendedProperties = "Extended Properties=Excel 8.0;"<br>    End Select<br>    Select Case lcase(sType)<br>        Case "access"<br>            ADO_BuildConnectionString = sProvider & "Data Source=" & sFile & ";"<br>        Case "excel"<br>            ADO_BuildConnectionString = sProvider & "Data Source=" & sFile & ";" & sExtendedProperties<br>        Case "sql"<br>            ADO_BuildConnectionString = "Provider=sqloledb;server=" & sFile & ";database=" & sDatabase & ";uid=" & sUsername & ";pwd=" & sPassword & ";"<br>    End Select   <br>End Function Function ADO_DBConnection(ByVal sConnectionString)<br>    ' Returns an ADODB.Connection object<br>    ' Example usage: <br>    '    Set oConnection = ADO_DBConnection(sConnectionString)<br>    Dim oConnection ' As ADODB.Connection<br>    Set oConnection = CreateObject("ADODB.Connection")<br>    oConnection.Open sConnectionString<br>    Set ADO_DBConnection = oConnection<br>End Function Function ADO_GetRecordset(ByVal strSQL, ByRef oDBConnection)<br>    ' Returns an ADODB.Recordset object<br>    ' Example usage:<br>    '    Set rsDel = ADO_GetRecordset(sSQL, oConnection)<br>        Dim rs<br>        Set rs = CreateObject("adodb.Recordset")<br>        rs.CursorLocation = adUseClient<br>        rs.Open strSQL, oDBConnection, adOpenStatic, adLockOptimistic<br>        Set ADO_GetRecordset = rs<br>End Function Function GetComputerName()<br>    Dim WshNetwork<br>    Set WshNetwork = WScript.CreateObject("WScript.Network")<br>    GetComputerName = WshNetwork.ComputerName <br>End Function Function FindObjectADsPath(sObjectClass, sUniqueID, sSearchDN, sSearchScope, sLDAPTargetDNS)<br>    ' Returns the full ADsPath (LDAP://...) of an object based on the unique identifier of the object<br>    ' Inputs:<br>    ' sObjectClass: The script supports: user, group, computer<br>    ' sUniqueID: The unique identifier for the object class.  The script supports:<br>    '    user: samAccountName<br>    '    computer: Name<br>    '    group: samAccountName<br>    ' sSearchDN: the DN within which to search (often, the DN of the domain, e.g. dc=windomain, dc=com)<br>    ' sSearchScope: the AD Search scope, which can be subtree or onelevel or base (subtree most common)<br>    ' sLDAPTargetDNS: a specific domain (DNS name) or domain controller - optional     Dim oConnection<br>    Dim oRecordset<br>    Dim sLDAPObjectQuery<br>    Dim sLDAPIdentifierQuery<br>    Dim sLDAPQuery<br>    Dim sProperties<br>    Dim oADObject<br>    Dim aProperties<br>    Dim sProperty<br>    Dim sLDAPIdentifier<br>    <br>    sLDAPObjectQuery = "(objectCategory=" & sObjectClass & ")"<br>    ' Based on the type of object, change the identifier that is being used<br>    Select Case lcase(sObjectClass)<br>        Case "user","group"<br>            sLDAPIdentifier = "samAccountName"<br>        Case "computer"<br>            sLDAPIdentifier = "Name"<br>        Case Else<br>            ' Error handling code: class not yet coded<br>            Exit Function<br>    End Select<br>    sProperties = "ADsPath"<br>    <br>    ' Open an ADO connection using null credentials<br>    Set oConnection = CreateObject("ADODB.Connection")<br>    oConnection.Provider = "ADsDSOObject"<br>    On Error Resume Next<br>    oConnection.Open "", vbNullString, vbNullString<br>    If oConnection.State = adStateClosed Then<br>         ' Error handling code<br>         ' WScript.Echo "ERROR: Connection to AD failed."<br>         Exit Function<br>    End If<br>    <br>    ' Build the LDAP Query<br>    If sLDAPTargetDNS > "" Then<br>        sLDAPQuery = "<LDAP://" & sLDAPTargetDNS & "/" & sSearchDN & ">;"<br>    Else<br>        sLDAPQuery = "<LDAP://" & sSearchDN & ">;"<br>    End If<br>    sLDAPQuery = sLDAPQuery & _<br>        "(&" & sLDAPObjectQuery & _<br>        "(" & sLDAPIdentifier & "=" & sUniqueID & ")" & _<br>        ");" & _<br>        sProperties & ";" & sSearchScope<br>    ' Don't forget the first ampersand as the AND logic<br>    <br>    ' Retrieve the result set, close the connection, and check to make<br>    ' sure we received at least one result<br>    Set oRecordset = oConnection.Execute (sLDAPQuery)<br>    If oRecordset.EOF and oRecordset.BOF Then<br>        ' Error handling code<br>        ' WScript.Echo "ERROR: No objects found." & VbCrLf & sLDAPQuery & vbCrLf & VbCrLf<br>        FindObjectADsPath = ""<br>         Exit Function<br>    End If<br>    <br>    FindObjectADsPath = oRecordset.Fields("ADsPath")<br>    oRecordset.Close<br>    oConnection.Close<br>    <br>End Function Function Group_AddMember (sGroupName, sMemberName, sMemberType)<br>    ' Adds a member to a group<br>    ' Inputs:<br>    ' sGroupName: samAccountName of the group<br>    ' sMemberName: samAccountName (user/group) or Name (computer) of member to add<br>    ' sMemberType: user, group, or computer<br>    ' Prerequisites: sDomainDN (the DN of the domain) and sDomainDNS (the DNS name of the domain)<br>    ' Dependencies: ErrorHandler and sScriptResults<br>    <br>    Dim sGroupADsPath, oGroup, sMemberADsPath, oMember<br>    sGroupADsPath = FindObjectADsPath("group", sGroupName, sDomainDN, "subtree", sDomainDNS)<br>    If sGroupADsPath = "" Then<br>        Group_AddMember = False<br>        sScriptResults = sScriptResults & "Could not find group: " & sGroupName<br>        Exit Function<br>    End If<br>    <br>    On Error Resume Next<br>    Set oGroup = GetObject(sGroupADsPath)<br>    If Err.Number <> vbEmpty Then<br>        Group_AddMember = False<br>        sScriptResults = sScriptResults & ErrorHandler ("Could not connect to group: " & sGroupName)<br>        Exit Function<br>    End If<br>    <br>    sMemberADsPath = FindObjectADsPath (sMemberType, sMemberName, sDomainDN, "subtree", sDomainDNS)<br>    If sMemberADsPath = "" Then<br>        Group_AddMember = False<br>        sScriptResults = sScriptResults & "Could not find " & sMemberType & ": " & sMemberName<br>        Exit Function<br>    End If<br>    <br>    oGroup.Add(sMemberADsPath)<br>    If Err.number <> vbEmpty Then<br>        Group_AddMember = False<br>        sScriptResults = sScriptResults & ErrorHandler ("Could not add " & sMemberType & " " & _<br>            sMemberName & " (" & sMemberADsPath & ") " & _<br>            " to group " & sGroupName & " (" & sGroupADsPath & ")")<br>        Exit Function<br>    End If<br>    Group_AddMember = True<br>    <br>End Function Function Group_RemoveMember (sGroupName, sMemberName, sMemberType)<br>    ' Removes a member from a group<br>    ' Inputs:<br>    ' sGroupName: samAccountName of the group<br>    ' sMemberName: samAccountName (user/group) or Name (computer) of member to add<br>    ' sMemberType: user, group, or computer<br>    ' Prerequisites: sDomainDN (the DN of the domain) and sDomainDNS (the DNS name of the domain)<br>    ' Dependencies: ErrorHandler and sScriptResults<br>    <br>    Dim sGroupADsPath, oGroup, sMemberADsPath, oMember<br>    sGroupADsPath = FindObjectADsPath("group", sGroupName, sDomainDN, "subtree", sDomainDNS)<br>    If sGroupADsPath = "" Then<br>        Group_RemoveMember = False<br>        sScriptResults = sScriptResults & "Could not find group: " & sGroupName<br>        Exit Function<br>    End If<br>    <br>    On Error Resume Next<br>    Set oGroup = GetObject(sGroupADsPath)<br>    If Err.Number <> vbEmpty Then<br>        Group_RemoveMember = False<br>        sScriptResults = sScriptResults & ErrorHandler ("Could not connect to group: " & sGroupName)<br>        Exit Function<br>    End If<br>    <br>    sMemberADsPath = FindObjectADsPath (sMemberType, sMemberName, sDomainDN, "subtree", sDomainDNS)<br>    If sMemberADsPath = "" Then<br>        Group_RemoveMember = False<br>        sScriptResults = sScriptResults & "Could not find " & sMemberType & ": " & sMemberName<br>        Exit Function<br>    End If<br>    <br>    oGroup.Remove(sMemberADsPath)<br>    If Err.number <> vbEmpty Then<br>        Group_RemoveMember = False<br>        sScriptResults = sScriptResults & ErrorHandler ("Could not remove " & sMemberType & " " & _<br>            sMemberName & " (" & sMemberADsPath & ") " & _<br>            " from group " & sGroupName & " (" & sGroupADsPath & ")")<br>        Exit Function<br>    End If<br>    Group_RemoveMember = True <br>    <br>End Function Function ErrorHandler( sErrorText )<br>    ' Returns a string describing the error and clears Err<br>    Dim sErrorHandler<br>    sErrorHandler = sErrorText & VbCrLf & _<br>        "Error number: " & Err.number & VbCrLf & _<br>        "Error Description: " & Err.Description<br>    Err.Clear<br>    ErrorHandler = sErrorHandler  <br>End Function