ADSI を使用して Exchange メールボックスのホーム サーバーを変更するサンプル スクリプト

 

次の Microsoft Visual Basic® サンプル スクリプトを使用すると、あるメールボックス データベースから別のデータベースに Exchange メールボックスのホーム サーバーを変更することもできます。

新しいテキスト ファイルに次のコードをコピーして貼り付け、このファイルを Rest.vbs として Restoring という名前の一時フォルダに保存してください。このスクリプトをコマンド プロンプトから実行するには、Restoring フォルダに移動して次のコマンドを実行します。

cscript rest.vbs

この例では、スクリプトによって次の属性が変更されます。

  • msExchHomeServerName
  • homeMDB
  • HomeMTA

これら 3 つの属性を直接入力するか、またはスクリプトを実行しているときにこの情報を入力します。スクリプトを実行しているときにこの情報入力する場合は、スクリプト内のコメント行を削除してください。

    'Begin Script

Option Explicit
    
    Dim oRootDSE
    Dim strNamingContext
    Dim strConfigurationNamingContext
    Dim oConnection 
    Dim oCmd
    Dim strADOQuery 
    Dim strAttributes 
    Dim strFilter 
    Dim oRecordSet 
    Dim oField 
    Dim usr
    Dim UserPath
    
    Dim NewOrganizationName
    Dim OldOrganizationName
    Dim OldServerName 
    Dim NewServerName 
    Dim OldAdminGroupName
    Dim NewAdminGroupName
    Dim OldStorageGroupName
    Dim NewStorageGroupName
    Dim OldBaseName
    Dim NewBaseName
    Dim OldMTAServerName
    Dim NewMTAServerName
    
    Dim value
    ReDim strArgumentArray(0)
    Dim i, iReturnCode
    Dim fInteractiveMode, fTrialMode, iSuccessCount, iFailureCount, iRecordCount
    
    fInteractiveMode = False
    fTrialMode = False
    iSuccessCount = 0
    iFailureCount = 0
    iRecordCount = 0
    
    
    For i = 0 to Wscript.arguments.count - 1
        ReDim Preserve strArgumentArray(i)
        strArgumentArray(i) = Wscript.arguments.item(i)
    Next
    
    
    For i = 0 to Wscript.arguments.count - 1
      Select case Left(LCase(strArgumentArray(i)),2) 
        case "/i"
          fInteractiveMode = True    
        case "/t"
          fTrialMode = True      
      End Select
    Next
    
    If fInteractiveMode = False Then
    
    '***********************************************************
    '****** Modify this section for your Parameters ************
    '***********************************************************
    
      OldOrganizationName = "Contoso Corp"
      NewOrganizationName = "Contoso Corp"
    
      OldServerName = "CONTOSO-01"
      NewServerName = "CONTOSO-02"
    
      OldAdminGroupName  = "First Administrative Group"
      NewAdminGroupName  = "First Administrative Group"
    
      OldStorageGroupName = "First Storage Group"
      NewStorageGroupName = "First Storage Group"
    
      OldBaseName = "Mailbox Store (CONTOSO-01)"
      NewBaseName = "Mailbox Store (CONTOSO-02)"
    
      OldMTAServerName = "CONTOSO-01"
      NewMTAServerName = "CONTOSO-02"
    
    '*************************************************************
    '************** Parameter Section End ************************
    '**************************************************************
      
      Trace("You are running in batch mode.  The parameters are:")
      
    Else
      ' Get information
      OldOrganizationName = Trim(InputBox("Type the name of the old Exchange Organization : ", "Information"))
      NewOrganiZationName = Trim(InputBox("Type the name of the new Exchange Organization : ", "Information"))
    
      OldServerName = Trim(InputBox("Type the name of the old Exchange server : ", "Information"))
      NewServerName = Trim(InputBox("Type the name of the new Exchange server : ", "Information"))
    
      OldAdminGroupName = Trim(InputBox("Type the name of the old administrative group : ", "Information"))
      NewAdminGroupName = Trim(InputBox("Type the name of the new administrative group : ", "Information"))
    
      OldStorageGroupName = Trim(InputBox("Type the name of the old Storage group : ", "Information"))
      NewStorageGroupName = Trim(InputBox("Type the name of the new Storage group : ", "Information"))
    
      OldBaseName = Trim(InputBox("Type the name of the old database name : ", "Information"))
      NewBaseName = Trim(InputBox("Type the name of the new database name : ", "Information"))
    
      OldMTAServerName = Trim(InputBox("Type the name of the old MTA Server : ", "Information"))
      NewMTAServerName = Trim(InputBox("Type the name of the new MTA Server : ", "Information"))
    
      Trace("Your parameters are:")
      
    End If
    
    '--- Get the Naming Context ----
    Set oRootDSE = GetObject("LDAP://RootDSE")
    strNamingContext = oRootDSE.Get("defaultNamingContext")
    strConfigurationNamingContext = oRootDSE.Get("configurationNamingContext")
    Set oRootDSE = Nothing
    
    Trace("Targetted Domain: " & vbTab & strNamingContext)
    Trace("Configuration Naming Context: " & vbTab & strConfigurationNamingContext)
    Trace("Old Organization Name: " & vbTab & OldOrganizationName)
    Trace("New Organization Name: " & vbTab & NewOrganizationName)
    Trace("Old Server Name:" & vbTab & OldServerName)
    Trace("New Server Name:" & vbTab & NewServerName)  
    Trace("Old AdminGroup Name:" & vbTab & OldAdminGroupName)
    Trace("New AdminGroup Name:" & vbTab & NewAdminGroupName)
    Trace("Old Storage Group Name:" & vbTab & OldStorageGroupName)
    Trace("New Storage Group Name:" & vbTab & NewStorageGroupName)  
    Trace("Old Base Name:" & vbTab & OldBaseName)
    Trace("New Base Name:" & vbTab & NewBaseName)
    Trace("Old MTA Server Name:" & vbTab & OldMTAServerName)
    Trace("New MTA Server Name:" & vbTab & NewMTAServerName)  
    
    iReturnCode = MsgBox("Is the information correct?", vbYesNo, "Confirmation")
    If iReturnCode = vbNo Then
      If fInteractiveMode = False Then
        MsgBox "Please open the VBScript with a text editor and modify the parameters", vbOKOnly, "Exit"
        Trace("Please open the VBScript with a text editor and modify the parameters")
        Wscript.Quit 0
      End If
    End If
    If fTrialMode = False Then
      iReturnCode = MsgBox("Would you like to perform a trial run of the operation instead of doing a real update?", vbYesNo, "Confirmation")
      If iReturnCode = vbYes Then
        fTrialMode = True
      End If
    End If
    If fTrialMode = True Then
      Trace ("********************************************************")
      Trace ("***   You are running in Trial Mode only             ***")
      Trace ("***   Information in Active Directory will not be updated          ***")
      Trace ("********************************************************")
    End If
      
    
    ' --- Get a filter from the user ---
    Trace("")
    'strFilter = "(msExchHomeServerName=/o=" + OldOrganizationName + "/ou=" + OldAdminGroupName + "/cn=Configuration/cn=Servers/cn=" + OldServerName + ")"
    'Trace("LDAP Filter = " + strFilter)
    strFilter = "(homeMDB=" + "CN=" + OldBaseName + ",CN=" + OldStorageGroupName + ",CN=InformationStore,CN=" + OldServerName + ",CN=Servers,CN=" + OldAdminGroupName + ",CN=Administrative Groups,CN=" + OldOrganizationName + ",CN=Microsoft Exchange,CN=Services,"+ strConfigurationNamingContext + ")"
    Trace("LDAP Filter = " + strFilter)
    
    '  --- Define the attributes to be returned from the query ---
    strAttributes = "name,distinguishedName,msExchHomeServerName,homeMDB,homeMTA"
    
    '--- Set up the connection ---
    Set oConnection = CreateObject("ADODB.Connection")
    Set oCmd = CreateObject("ADODB.Command")
    oConnection.Provider = "ADsDSOObject"
    oConnection.Open "ADs Provider"
    Set oCmd.ActiveConnection = oConnection
    
    '--- Build the query string ---
    strADOQuery = "<LDAP://" + strNamingContext + ">;(&(objectCategory=person)(objectClass=user)" + strFilter + ");" + strAttributes + ";subtree"
    oCmd.CommandText = strADOQuery
    oCmd.Properties("Page Size") = 1000
    oCmd.Properties("Timeout") = 1000
    oCmd.Properties("Cache Results") = False 
    
    '--- Run the query for the user in the directory ---
    Set oRecordSet = oCmd.Execute
    If oRecordSet.EOF Then
      Trace("No Matching Users.  Program Aborted") 
      Wscript.Quit 1
    End If
    
    While Not oRecordSet.EOF
      Trace("")
      Trace("---------------------------------------------------------------------------")
      Trace("---------------------------------------------------------------------------")
      Trace("---------------------------------------------------------------------------")
      Trace("Work to : "+oRecordSet.Fields(0) + vbTab + oRecordSet.Fields(1))
      Trace("-----------------------------------------------")
      Trace("")
      Set usr = GetObject("LDAP://"+oRecordSet.Fields(1))
    
      ' Modify msExchHomeServerName attribute
      value = usr.Get("msExchHomeServerName")
      Trace("OLD msExchHomeServerName = "+value)
      Trace("-----------------------")
      value = "/o=" + NewOrganizationName + "/ou=" + NewAdminGroupName + "/cn=Configuration/cn=Servers/cn=" + NewServerName
      usr.Put "msExchHomeServerName", value
      Trace("NEW msExchHomeServerName = "+value)
      Trace("-----------------------------------------------")
    
      ' Modify homeMDB attribute
      value = usr.Get("homeMDB")
      Trace("OLD homeMDB = "+value)
      Trace("-----------------------")
      value = "CN=" + NewBaseName + ",CN=" + NewStorageGroupName + ",CN=InformationStore,CN=" + NewServerName + ",CN=Servers,CN=" + NewAdminGroupName + ",CN=Administrative Groups,CN=" + NewOrganizationName + ",CN=Microsoft Exchange,CN=Services,"+ strConfigurationNamingContext
      usr.Put "homeMDB", value
      Trace("NEW homeMDB = "+value)
      Trace("-----------------------------------------------")
    
      ' Modify homeMTA attribute
      value = usr.Get("homeMTA")
      Trace("OLD homeMTA = "+value)
      Trace("-----------------------")
      value = "CN=Microsoft MTA,CN=" + NewMTAServerName + ",CN=Servers,CN=" + NewAdminGroupName + ",CN=Administrative Groups,CN=" + NewOrganizationName + ",CN=Microsoft Exchange,CN=Services," + strConfigurationNamingContext
      usr.Put "homeMTA", value
      Trace("NEW homeMTA = "+value)
      Trace("-----------------------------------------------")
    
      On Error Resume Next 
      If fTrialMode = False Then
        usr.SetInfo
        If Err.Number Then
          Trace("")
          Trace("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
          Trace("Error Updating User: " & oRecordSet.Fields(0) & "    Reason: " & Err.Description)
          Trace("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
          Trace("")
          iFailureCount = iFailureCount + 1
          Err.Clear
        Else
          iSuccessCount = iSuccessCount + 1
        End If
      End If
      On Error Goto 0
      iRecordCount = iRecordCount + 1
      oRecordSet.MoveNext
    Wend
    
    ' -- Clean up --
    oRecordSet.Close
    oConnection.Close
    Set oField = Nothing
    Set oRecordSet = Nothing
    Set oCmd = Nothing
    Set oConnection = Nothing
    Set usr = Nothing
    
    ' Provide Summary
    Trace ("")
    Trace ("************* Summary **************")
    If fTrialMode = True Then
      Trace ("Running in Trial Mode")
    End If
    Trace ("Records Found: " & iRecordCount)
    Trace ("Successful Update: " & iSuccessCount)
    Trace ("Failure Update: " & iFailureCount)
    
    
    
    ' -------------------------------------------------------
    ' -------------------------------------------------------
    ' -------------------------------------------------------
    '
    ' -------------------------------------------------------
    ' -------------------------------------------------------
    ' -------------------------------------------------------
    
    Sub Trace(message)
       WScript.Echo message
    end sub
'End script

詳細情報

Exchange の管理と開発に使用できる API およびインターフェイスの詳細については、Microsoft Exchange SDK を参照してください (このサイトは英語の場合があります)。

メールボックスの有効化や無効化を行ったり、メールボックスのホーム サーバーを変更したりするその他の方法の詳細については、「Active Directory 属性を使用したメールボックスの有効化、無効化、およびホーム サーバーの変更」を参照してください。

Exchange メールボックスのデータベースの移動に関する詳細については、「別のサーバーまたはストレージ グループへの Exchange メールボックス データベースの移動」を参照してください。