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

参考：

• https://www.hmailserver.com/forum/viewtopic.php?p=197910#p197910
• https://www.hmailserver.com/documentation/latest/?page=com_example_account_create