hMailServer - 批量创建用户 - vbs脚本
需求：通过csv文件，能批量导入邮箱地址和密码，如
chen10,nfhe7384,hmail2.demo.anqun.org
chen11,nfhe755t,hmail2.demo.anqun.org
chen12,nfhe755t,hmail3.demo.anqun.org尝试：通过hMailServer的COM API，用vbs脚本可从csv文件读取邮箱用户、密码和域名。
脚本内容：
'#####the script#####
'# The EntryType can be one of two options, User or Alias. If the EntryType is User, then:
'#
'# EntryType = User
'# Field1 = Uername
'# Field2 = Password
'# Field3 = DomainName
'# Field4 = FirstName
'# Field5 = LastName
'#
'# If the EntryType is Alias, then:
'# EntryType = Alias
'# Field1 = AliasName
'# Field2 = ForwardingEmail
'# Field3 = DomainName
'#
'# To add USERS, for example, your CSV file should have the structured information (type, strUsername, strPassword, strDomain, strPersonFirstName, strPersonLastName), like below:
'# User,tjones,mypassword,jones.com,Tommy,Jones
'#
'# To add ALIAS, for example, your CSV file should have the structured information (type, strAlias, strAliasUsername, strDomain), like below:
'# Alias,tommy,tjones@jones.com,jones.com
'#
'# This would create a user names tjones@jones.com in the jones.com domain and an alias tommy@jones.com which will forward all e-mail to tjones@jones.com in the jones.com domain.
'####################
Option Explicit
Dim Elog
Dim obBaseApp
Dim objFSO
Dim objTextFile
Dim strNewAlias,i
Dim failed
Dim added
Dim domainsAdded
failed = 0
added = 0
domainsAdded = 0
'#####################################################################
'# Custom Variables regarding HMAIL admin password and file to be read
'#####################################################################
Dim hAdminpwd
Dim CSVFile
hAdminpwd = "hmailmima"
CSVFile = "bulk.csv"
Set Elog = CreateObject("hMailServer.EventLog")
Set obBaseApp = CreateObject("hMailServer.Application")
Call obBaseApp.Authenticate("Administrator",hAdminpwd) '*** N.B. 1. set your administrator password in this line
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(CSVFile, ForReading) 'N.B. 2. Set your CSV path/filename in this line
On Error resume next
Do While objTextFile.AtEndOfStream <> True
strNewAlias = split(objTextFile.Readline, ",")
'Select Case lcase(trim(strNewAlias(0)))
'Case "user"
' AddUser trim(strNewAlias(1)), trim(strNewAlias(2)), trim(strNewAlias(3)),trim(strNewAlias(4)),trim(strNewAlias(5))
'Case "alias"
'AddAlias trim(strNewAlias(1)), trim(strNewAlias(2)), trim(strNewAlias(3))
'End Select
AddUser trim(strNewAlias(0)), trim(strNewAlias(1)), trim(strNewAlias(2))
If err.Number <> 0 Then 'error handling:
Elog.Write("Failed add (probably duplicate)" & Chr(34) & vbTab & Chr(34) & strNewAlias(0) _
& "," & strNewAlias(1) & "," & strNewAlias(2) & "," & strNewAlias(3))
failed = failed + 1
err.Clear
Else
added = added + 1
End If
Loop
On Error goto 0
Elog.Write("Domains Added Sucessfully = " & domainsAdded)
Elog.Write("Accounts Added Sucessfully = " & added)
Elog.Write("Failed or Duplicate Accounts = " & failed)
Wscript.Echo ("Domains Added Sucessfully = " & domainsAdded & VbNewLine _
& "Accounts Added Sucessfully = " & added & VbNewLine _
& "Failed or Duplicate Accounts = " & failed & VbNewLine & VbNewLine _
& "See hmailserver_events.log for list of duplicates (if any)")
'###################
'# Usefull functions
'###################
Sub AddAlias(strAlias,strEmailAddress,strDomain)
AddDomain strDomain
Dim obDomain
Dim obAliases
Dim obNewAlias
Set obDomain = obBaseApp.Domains.ItemByName(strDomain)
Set obAliases = obDomain.Aliases
Set obNewAlias = obAliases.Add()
obNewAlias.Name = strAlias & "@" & strDomain 'username
obNewAlias.Value = strEmailAddress 'password
obNewAlias.Active = 1 'activates user
obNewAlias.Save() 'saves account
Set obNewAlias = Nothing
Set obAliases = Nothing
Set obDomain = Nothing
End Sub
'Sub AddUser(strUsername, strPassword, strDomain, strPersonFirstName, strPersonLastName)
Sub AddUser(strUsername, strPassword, strDomain)
AddDomain strDomain
Dim obDomain
Dim obAccounts
Dim obNewAccount
Set obDomain = obBaseApp.Domains.ItemByName(strDomain)
Set obAccounts = obDomain.Accounts
Set obNewAccount = obAccounts.Add()
obNewAccount.Address = strUsername & "@" & strDomain 'username
obNewAccount.Password = strPassword 'password
'obNewAccount.PersonFirstName = strPersonFirstName
'obNewAccount.PersonLastName = strPersonLastName
obNewAccount.Active = 1 'activates user
obNewAccount.Maxsize = 0 'sets mailbox size, 0=unlimited
obNewAccount.Save() 'saves account
Set obNewAccount = Nothing
Set obDomain = Nothing
Set obAccounts = Nothing
End Sub
Sub AddDomain(strDomain)
Dim obNewDomain
Set obNewDomain = obBaseApp.Domains.Add()
obNewDomain.Name = strDomain
obNewDomain.Active = True
On Error resume next
obNewDomain.Save()
If err.Number = 0 Then
domainsAdded = domainsAdded + 1
End If
err.Clear
obBaseApp.Domains.Refresh()
End Sub参考：