Exchange-Admin Blog

メールボックスインポートスクリプト

Exchange 2000 Server, Exchange Server 2003 で、メールボックスを CSVファイルからインポートして一括作成・更新するスクリプトです。
シングルドメインで、すべて Users コンテナに作成します。
エラー処理はイマイチですが、問題があったら大体止まると思います。
何かやる前にログ出力してから実行するので、作成されるログファイルを見たらどこで止まったかわかります。
実際に使用していたものから特殊なことを取り除いたので、修正したときのバグはあるかもしれません。

動作確認：SBS2000(Windows 2000 Server SP4), SBS2003 RC(Windows Server 2003)

ImportRecip.vbs

'

' 受信者一括インポートスクリプト

'

' メールボックスが有効なユーザ、メールが有効なユーザを作成します。

' メールボックスの場合は転送先アドレスと両方に配信するかどうかを指定できます。

' 転送先は con0-エイリアス, con1-エイリアス, ... という名前で作成し、

' alt-エイリアス という名前のグループに入れて代理受信者に設定します。


Option Explicit

' デフォルトのインポートファイル名

Const strDefaultImportFileName = "ImportRecip.csv"

' デフォルトのログファイル

Const strDefaultLogFileName = "ImportRecip.log"

' 組織の DNS名

Const strDefaultOrganizationDNSName = "exchange-admin.biz"

' 組織名

Const strDefaultOrganizationName = "EXCHANGE-ADMIN"

' 管理グループ名

Const strDefaultAdministrativeGroupName = "最初の管理グループ"

' Exchange Server 2003 のデフォルトは "first administrative group"

' ストレージグループ名

Const strDefaultStorageGroupName = "最初のストレージ グループ"

' 最大転送アドレス数(0番目を含まない)

Const MaxForwardingAddresses = 9

Dim strNeededColumnHeader

' インポート用 CSVファイルの１行目を、次の項目名並びと同じにしてください(" を除く)

' 使用する項目名並び

strNeededColumnHeader = _

    "alias,password,external_address,ServerName," & _

    "LastName,FirstName,DisplayName,Department,Title," & _

    "DeliverBoth,ForwardingAddress0," & _

    "ForwardingAddress1,ForwardingAddress2,ForwardingAddress3," & _

    "ForwardingAddress4,ForwardingAddress5,ForwardingAddress6," & _

    "ForwardingAddress7,ForwardingAddress8,ForwardingAddress9"

' 意味は

'

' エイリアス(アカウント名を兼ねる)

' パスワード(新規作成の場合のみ設定)

' 外部アドレス(メールが有効なユーザの場合)

' サーバ名(メールボックスが有効なユーザの場合)

' 名字

' 名前

' 表示名

' 部署

' 役職

' メッセージを転送先とメールボックスの両方に配信する(1 or 0)

' 転送先アドレス0

' 転送先アドレス1

' 転送先アドレス2

'      ・

'      ・

'      ・

Dim objFileSystemObject

Dim objFile

Dim mapColumnNameIndex

Dim strColumnNames

Dim strLogFileName

Dim strDelivaryDomain

Dim strServerName

Dim strOrganizationDNSName

Dim strDomainPath

Dim strOrganizationName

Dim strAdministrativeGroupName

Dim strStorageGroupName

Dim strStoreName

Dim nMailEnabled

Dim nMailBoxEnabled

Dim nMailBoxMustMove

Dim nMailBoxMustDelete

strLogFileName = strDefaultLogFileName

strOrganizationDNSName = strDefaultOrganizationDNSName

strDomainPath = "DC=" & Replace(strOrganizationDNSName, ".", ",DC=")

strOrganizationName = strDefaultOrganizationName

strAdministrativeGroupName = strDefaultAdministrativeGroupName

strStorageGroupName = strDefaultStorageGroupName

nMailEnabled = 0

nMailBoxEnabled = 0

nMailBoxMustMove = 0

nMailBoxMustDelete = 0

Call Main

' メイン

Sub Main()

    Dim strFilePath

    Dim strLine

    Dim strLineTop

    Dim bHeaderLoaded

    Dim aHeader

    Dim i

    Dim aLine

    

    ' ファイル名の取得

    strFilePath = GetImportFileName()

    If strFilePath = "" Then

        Call Cleanup()

        Exit Sub

    End If

    

    ' ファイルシステムオブジェクト・テキストストリームオブジェクト作成

    Set objFileSystemObject = Nothing

    Set objFile = Nothing

    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")

    Set objFile = objFileSystemObject.OpenTextFile(strFilePath)

    If objFileSystemObject Is Nothing Or objFile Is Nothing Then

        Call Cleanup()

        MsgBox "ファイルシステムオブジェクトまたはテキストストリームオブジェクト作成失敗"

        Exit Sub

    End If

    

    LogWriteLine ""

    LogWriteLine ""

    LogWriteLine ""

    LogWriteLine "開始 " & Now  

    ' ヘッダーの読み込み

    bHeaderLoaded = False

    Do Until objFile.AtEndOfStream

        strLine = objFile.ReadLine

        If LoadHeader(strLine, aHeader) = True Then

            bHeaderLoaded = True

            Exit Do

        End If

    Loop

    

    ' ヘッダーが無かったら終了

    If bHeaderLoaded = False Then

        Call Cleanup()

        MsgBox "ヘッダー無し"

        Exit Sub

    End If

    

    ' 項目名－インデックスマップの作成

    Set mapColumnNameIndex = Nothing

    Set mapColumnNameIndex = CreateObject("Scripting.Dictionary")

    If mapColumnNameIndex Is Nothing Then

        Call Cleanup()

        MsgBox "項目名－インデックスマップの(オブジェクト)作成失敗"

        Exit Sub

    End If

    

    For i = 0 To Ubound(aHeader) Step 1

        mapColumnNameIndex.Add aHeader(i), i

    Next

    Erase aHeader

    

    strColumnNames = strNeededColumnHeader

    

    ' データ行の読み込み

    Do Until objFile.AtEndOfStream

        strLine = objFile.ReadLine

        If IsComment(strLine) = False Then

            aLine = Split(strLine, ",")

            If IsArray(aLine) Then

                Call DoUpdateRecipient(aLine)

                Erase aLine

            End If

        End If

    Loop

    

    LogWriteLine "-------------------------------------------------------------------------------"

    LogWriteLine "終了 " & Now  

    LogWriteLine "メールが有効なユーザー：" & CStr(nMailEnabled)

    LogWriteLine "メールボックス：" & CStr(nMailBoxEnabled)

    LogWriteLine "移動すべきメールボックス：" & CStr(nMailBoxMustMove)

    LogWriteLine "削除すべきメールボックス：" & CStr(nMailBoxMustDelete)

    LogWriteLine "-------------------------------------------------------------------------------"

    LogWriteLine ""

    Call Cleanup()

    MsgBox "終了"

End Sub

' 終了処理

Sub Cleanup()

    On Error Resume Next

    Set mapColumnNameIndex = Nothing

    Set objFile = Nothing

    Set objFileSystemObject = Nothing

End Sub

' ログ出力

Sub LogWrite(str)

    Dim objText

    Set objText = objFileSystemObject.OpenTextFile(strLogFileName, 8, True)

    objText.Write str

    objText.Close

    Set objText = Nothing

End Sub

Sub LogWriteLine(str)

    LogWrite(str & vbCrLf)

End Sub

' ファイル名の取得

Function GetImportFileName()

    Dim strImportFile

    

    ' プロンプト

    strImportFile = InputBox("インポートファイル名を入力してください", _

        "インポートファイル名の入力(ImportRecip)", strDefaultImportFileName)

    

    If Len(strImportFile) > 5 Then

        strLogFileName = Left(strImportFile, Len(strImportFile) - 4) & ".log"

    End If

    

    GetImportFileName = strImportFile

End Function

' ヘッダー行の読み込み

Function LoadHeader(strLine, aHeader)

    If IsComment(strLine) = True Then

        LoadHeader = False

        Exit Function

    End If

    

    aHeader = Split(strLine, ",")

    If IsArray(aHeader) = False Then

        LoadHeader = False

    End If

    

    LoadHeader = True

End Function

' コメント行の判定

Function IsComment(strLine)

    If LTrim(strLine) = "" Then

        IsComment = True

        Exit Function

    ElseIf Left(LTrim(strLine), 1) = "'" Then

        IsComment = True

        Exit Function

    End If

End Function

Sub DoUpdateRecipient(aLine)

    Dim strCallingSequence

    Dim strHeader

    Dim aColumnName

    Dim i

    

    aColumnName = Split(strColumnNames, ",")

    

    strCallingSequence = "Call UpdateRecipient("""

    For i = 0 To UBound(aColumnName) Step 1

        If i <> 0 Then

            strCallingSequence = strCallingSequence & """, """

        End If

        If mapColumnNameIndex.Exists(aColumnName(i)) Then

            If UBound(aLine) >= mapColumnNameIndex.Item(aColumnName(i)) Then

                strCallingSequence = strCallingSequence & aLine(mapColumnNameIndex.Item(aColumnName(i)))

            End If

        Else

            ' 必要な項目が無い

            MsgBox "必要な項目が無い"

            Exit Sub

        End If

    Next

    strCallingSequence = strCallingSequence & """)"

    

    Erase aColumnName

    Execute strCallingSequence

End Sub

' 受信者の更新

Sub UpdateRecipient(alias,password,external_address,ServerName,LastName,FirstName, _

	DisplayName,Department,Title,DeliverBoth,ForwardingAddress0,ForwardingAddress1, _

	ForwardingAddress2,ForwardingAddress3,ForwardingAddress4,ForwardingAddress5, _

	ForwardingAddress6,ForwardingAddress7,ForwardingAddress8,ForwardingAddress9)

	

    Dim objPrimitiveUser

    Dim objUser

    Dim objContainer

    Dim rn

    Dim objMailRecipUser

    Dim objMailBox

    Dim HomeMDBURL

    Dim objPrimitiveGroup

    Dim objGroup

    Dim objPrimitiveContact

    Dim objMailRecipGroup

    Dim objMailRecipContact

    Dim strContactPath

    Dim aProxyAddresses

    Dim varProxy

    Dim bFound

    Dim strAppendAddress

    Dim i

    Dim param

    Dim bMemberExists

    If alias = "" Then

        Exit Sub

    End If

    LogWriteLine "-------------------------------------------------------------------------------"

    LogWriteLine "開始:" & Now & " " & alias

    rn = "CN=" & alias

    Set objContainer = GetObject("LDAP://CN=Users," + strDomainPath)

    

    ' ユーザーオブジェクト

    LogWriteLine "ユーザーオブジェクト"

    On Error Resume Next

    Set objPrimitiveUser = Nothing

    Set objPrimitiveUser = objContainer.GetObject("user", rn)

    If objPrimitiveUser Is Nothing Then

        ' ユーザが見つからない

        On Error GoTo 0

        LogWriteLine "user オブジェクトを作成"

        Set objPrimitiveUser = objContainer.Create("user", rn)

        objPrimitiveUser.Put "samAccountName", alias

        objPrimitiveUser.Put "userAccountControl", 66048

        objPrimitiveUser.Put "userPrincipalName", alias

        objPrimitiveUser.Put "sn", LastName

        objPrimitiveUser.Put "givenName", FirstName

        objPrimitiveUser.Put "description", DisplayName

        objPrimitiveUser.Put "displayName", DisplayName

        

        LogWriteLine "user オブジェクトをコミット"

        objPrimitiveUser.SetInfo

        Set objUser = objPrimitiveUser  ' IADsUser を使う

        LogWriteLine "パスワードを設定"

        objUser.SetPassword password

    Else

        On Error GoTo 0

        LogWriteLine "user オブジェクトを取得"

        objPrimitiveUser.Put "userPrincipalName", alias

        objPrimitiveUser.Put "sn", LastName

        objPrimitiveUser.Put "givenName", FirstName

        objPrimitiveUser.Put "description", DisplayName

        objPrimitiveUser.Put "displayName", DisplayName

        

        LogWriteLine "user オブジェクトをコミット"

        objPrimitiveUser.SetInfo

        

        Set objUser = objPrimitiveUser  ' IADsUser を使う

    End If

    

    If Department <> "" Then

        objPrimitiveUser.Put "department", Department                   ' 部署

        objPrimitiveUser.Put "physicalDeliveryOfficeName", Department   ' 事業所

    Else

        objPrimitiveUser.PutEx 1, "department", ""

        objPrimitiveUser.PutEx 1, "physicalDeliveryOfficeName", ""

    End If

    If Title <> "" Then

        objPrimitiveUser.Put "title", Title                             ' 役職

    Else

        objPrimitiveUser.PutEx 1, "title", ""

    End If

    

    objPrimitiveUser.SetInfo

    Set objMailRecipUser = objPrimitiveUser

    

    ' グループと連絡先の掃除

    

    ' 転送アドレスループ

    For i = 0 To MaxForwardingAddresses Step 1

        rn = "CN=con" & CStr(i) & "-" & alias

        ' 転送用連絡先を削除する

        On Error Resume Next

        Set objPrimitiveContact = Nothing

        Set objPrimitiveContact = objContainer.GetObject("contact", rn)

        If Not objPrimitiveContact Is Nothing Then

            ' 連絡先があった

            On Error GoTo 0

            LogWriteLine "転送用連絡先" & CStr(i) & "を(一旦?)削除"

            objContainer.Delete objPrimitiveContact.Class, objPrimitiveContact.Name

            Set objPrimitiveContact = Nothing

        End If

        On Error GoTo 0

    Next

    

    ' 転送用配布リストを削除

    rn = "CN=alt-" & alias

    On Error Resume Next

    Set objPrimitiveGroup = Nothing

    Set objPrimitiveGroup = objContainer.GetObject("group", rn)

    If Not objPrimitiveGroup Is Nothing Then

        On Error GoTo 0

        LogWriteLine "転送用配布グループを(一旦?)削除"

        objContainer.Delete objPrimitiveGroup.Class, objPrimitiveGroup.Name

    End If

    On Error GoTo 0

    

    ' メールボックスが必要かどうか

    If external_address <> "" Then

        '-------------------------------------------

        ' メールが有効なユーザー(メールボックス無し)

        '-------------------------------------------

        LogWriteLine "メールが有効なユーザー"

        Set objMailBox = objUser

        ' メールボックスが有効な場合は削除する(かな？)

        If objMailBox.HomeMDB <> "" Then

            ' メールボックスを削除

            LogWriteLine "削除する必要があるメールボックス"

            'objMailBox.DeleteMailBox

            nMailBoxMustDelete = nMailBoxMustDelete + 1

        Else

        

            ' メールを無効にする

            LogWriteLine "メールを一旦無効にする"

            On Error Resume Next

            objMailRecipUser.MailDisable

            On Error GoTo 0

            ' メールを有効にする

            objMailRecipUser.Alias = alias

            LogWriteLine "メールを有効にする"

            objMailRecipUser.MailEnable("SMTP:" & external_address)

            LogWriteLine "外部アドレスを設定"

            objMailRecipUser.SMTPEmail = external_address

            

            ' SecondaryProxyAddresses に内部のアドレスを入れる

            LogWriteLine "内部アドレスを追加"

            aProxyAddresses = objMailRecipUser.ProxyAddresses

            bFound = False

            strAppendAddress = "smtp:" & alias & "@" & strOrganizationDNSName

            If VarType(aProxyAddresses) = 8204 Then ' Variant 型配列

                For Each varProxy In aProxyAddresses

                    If UCase(CStr(varProxy)) = UCase(strAppendAddress) Then

                        bFound = True

                    End If

                Next

                If bFound = False Then

                    ReDim Preserve aProxyAddresses(UBound(aProxyAddresses) + 1)

                    aProxyAddresses(UBound(aProxyAddresses)) = strAppendAddress

                    objMailRecipUser.ProxyAddresses = aProxyAddresses

                End If

                Erase aProxyAddresses

            ElseIf VarType(aProxyAddresses) = 8 Then ' 文字列型

                If UCase(aProxyAddresses) <> UCase(strAppendAddress) Then

                    objMailRecipUser.ProxyAddresses = Array(aProxyAddresses, strAppendAddress)

                End If

            Else

                objMailRecipUser.ProxyAddresses = Array(strAppendAddress)

            End If

            

            nMailEnabled = nMailEnabled + 1

        End If

    Else

        '-------------------------------

        ' メールボックスが必要なユーザー

        '-------------------------------

        LogWriteLine "メールボックスユーザー"

        

        strServerName = UCase(ServerName)

        LogWriteLine "サーバー：" & strServerName

        strStoreName = "メールボックス ストア (" & strServerName & ")"

        LogWriteLine "ストア：" & strStoreName

        

        ' メールボックス

        Set objMailBox = objUser

        ' HomeMDB プロパティを組み立てる

        HomeMDBURL = _

            "CN=" & strStoreName & _

            ",CN=" & strStorageGroupName & ",CN=InformationStore," & _

            "CN=" & strServerName & ",CN=Servers," & _

            "CN=" & strAdministrativeGroupName & "," & _

            "CN=Administrative Groups,CN=" & strOrganizationName & "," & _

            "CN=Microsoft Exchange,CN=Services," & _

            "CN=Configuration," & strDomainPath

        

        If objMailBox.HomeMDB = "" Then

            ' メールボックスが無い

            ' メールが有効な可能性があるので無効にする

            LogWriteLine "メールを無効にする"

            On Error Resume Next

            objMailRecipUser.MailDisable

            On Error GoTo 0

            objPrimitiveUser.Put "mailNickname", alias

            LogWriteLine "メールボックスを作成"

            objMailBox.CreateMailbox HomeMDBURL

        ElseIf objMailBox.HomeMDB <> HomeMDBURL Then

            ' メールボックス移動

            LogWriteLine "メールボックスの移動が必要"

            nMailBoxMustMove = nMailBoxMustMove + 1

            'objMailBox.MoveMailBox HomeMDBURL

        End If

        

        ' プライマリSMTPアドレス

        objMailRecipUser.SMTPEmail = alias & "@" & strOrganizationDNSName

        

        ' 転送用配布グループ

        rn = "CN=alt-" & alias

        LogWriteLine "配布グループを作成"

        Set objPrimitiveGroup = objContainer.Create("group", rn)

        

        'typedef enum {

        '  ADS_GROUP_TYPE_GLOBAL_GROUP              = 0x00000002,

        '  ADS_GROUP_TYPE_DOMAIN_LOCAL_GROUP    = 0x00000004,

        '  ADS_GROUP_TYPE_LOCAL_GROUP               = 0x00000004,

        '  ADS_GROUP_TYPE_UNIVERSAL_GROUP       = 0x00000008,

        '  ADS_GROUP_TYPE_SECURITY_ENABLED      = 0x80000000

        '  } ADS_GROUP_TYPE_ENUM;

        

        objPrimitiveGroup.Put "samAccountName", "alt-" & alias

        objPrimitiveGroup.Put "groupType", 4

        LogWriteLine "配布グループをコミット"

        objPrimitiveGroup.SetInfo

        

        Set objGroup = objPrimitiveGroup

        

        ' 転送アドレスループ

        For i = 0 To MaxForwardingAddresses Step 1

            ' 転送用連絡先を作成して、配布グループのメンバーにする

            

            rn = "CN=con" & CStr(i) & "-" & alias

            param = "ForwardingAddress" & CStr(i)

            

            ' 転送先アドレスがあれば連絡先を作成して配布グループに追加

            If Eval(param & " <> """"") = True Then

                LogWriteLine "連絡先オブジェクト" & CStr(i) & "を作成"

                Set objPrimitiveContact = objContainer.Create("contact", rn)

                

                Set objMailRecipContact = objPrimitiveContact

                objMailRecipContact.Alias = "con" & CStr(i) & "-" & alias

                

                Execute "objPrimitiveContact.Put ""displayName"", " & param

                Execute "objMailRecipContact.MailEnable(""SMTP:"" & " & param & ")"

                

                objMailRecipContact.HideFromAddressBook = True

                LogWriteLine "連絡先オブジェクト" & CStr(i) & "をコミット"

                objPrimitiveContact.SetInfo

                

                strContactPath = objPrimitiveContact.AdsPath

                LogWriteLine "配布グループに連絡先" & CStr(i) & "を追加"

                objGroup.Add strContactPath

                

                bMemberExists = True

            End If

        Next

        

        Set objMailRecipGroup = objGroup

        If objMailRecipGroup.Alias = "" Then

            objMailRecipGroup.Alias = "alt-" & alias

            LogWriteLine "配布グループのメールを有効にする"

            objMailRecipGroup.MailEnable

        End If

        objMailRecipGroup.SMTPEmail = "alt-" & alias & "@" & strOrganizationDNSName

        objMailRecipGroup.HideFromAddressBook = True

        LogWriteLine "配布グループをコミット"

        objPrimitiveGroup.SetInfo

        

        ' 配布グループ作成後のメールボックスの処理

        If bMemberExists = True Then

            ' メールボックスの代理受信者に設定

            LogWriteLine "代理受信者を設定"

            objMailRecipUser.ForwardTo = objPrimitiveGroup.AdsPath

            LogWriteLine "メールボックスに残すかどうかを設定"

            If DeliverBoth = "1" Then

                objMailRecipUser.ForwardingStyle = 1

            Else

                objMailRecipUser.ForwardingStyle = 0

            End If

            'cdoexmRecipientOrForward   0   代理受信者のみへ配信

            'cdoexmDeliverToBoth        1   受信者と代理受信者の両方に配信

        Else

            ' 転送先が無ければ配布グループを削除

            LogWriteLine "転送先が無かったため、代理受信者用配布グループを削除"

            objContainer.Delete objPrimitiveGroup.Class, objPrimitiveGroup.Name

            ' メールボックスの代理受信者設定を外す

            objMailRecipUser.ForwardingStyle = 0

            LogWriteLine "代理受信者を解除"

            objMailRecipUser.ForwardTo = ""

        End If

        

        nMailBoxEnabled = nMailBoxEnabled + 1

    End If

    

    LogWriteLine "ユーザーオブジェクトをコミット"

    objPrimitiveUser.SetInfo

    

    LogWriteLine "終了:" & Now & " " & alias

    LogWriteLine ""

    LogWriteLine ""

    

    On Error Resume Next

    

    Set objMailRecipGroup = Nothing

    Set objMailRecipContact = Nothing

    Set objGroup = Nothing

    Set objPrimitiveGroup = Nothing

    Set objPrimitiveContact = Nothing

    Set objMailRecipUser = Nothing

    Set objMailBox = Nothing

    Set objUser = Nothing

    Set objPrimitiveUser = Nothing

    Set objContainer = Nothing

End Sub