Notes 注册：如何使用 lotus 脚本在注册期间创建副本邮件
Notes Registration: how to create replica mail during Registration using lotus script
客户有两个邮件服务器，它们是：
mailsvr1/bdy
mailsvr2/bdy
问题: 客户希望使用一个应用程序来注册笔记帐户。目前我只能用一个电子邮件帐户注册一个笔记帐户，我不知道如何创建一个副本邮件到另一台服务器。但是我去notesregistration那里有创建副本邮件到另一台服务器的功能
On Error GoTo ErrorHandler
Print "Register user agent started....."
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim groups
groups = Null
groups = group(groups,"Everyone")
' groups = group(groups,"Sales & Marketing PR Approval Team")
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailfile As String
Dim userpasswd As String
Dim internetpathLength As String
Dim internetpath As String
Dim remapuserID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0) ' full path of cert id
certpasswd = depdoc.IdPassword(0) ' Cert id password(password)
OU = "" 'depdoc.Dept(0) ' Application (department to register)
lastname= doc.Name(0) ' current document selected mail (person)
firstname = "" ' [din't used]
middleinit = "" ' [din't used]
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id" ' user path
' remove "." replace with empty and remove the empty space
remapuserID = remapChr(doc.SelectMail(0)) ' this is remapuserID
mailsvr = depdoc.MailSvr(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+ remapuserID ' Mail\Person
userpasswd= depdoc.UserPassword(0) ' User password
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
internetpathLength = Len(depdoc.InternetPath(0)) ' not used
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr '"mailsvr/bdy"
reg.CreateMailDb = True '
reg.CertifierIDFile = certid '"C:\IBM\Domino\data\office.id"
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1 ' password strength
reg.IsNorthAmerican = True
reg.OrgUnit = OU ' "" empty ..will just follow certid registration
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.Storeidinaddressbook = False
reg.MailInternetAddress = internetpath '"desmond@devsv1.pcs.com.my"
reg.Shortname=doc.SelectMail(0) ' 'Set shortname []
reg.Mailowneraccess =2 ' '[editor access]
reg.Mailcreateftindex=True ' '[Indexing]
' "CN=Lotus Administrator/O=Notes85"
reg.Mailaclmanager ="LocalDomainAdmins" ' 'Add person into mail acl
reg.Grouplist=groups ' 'Everyone and allstaff
Call reg.RegisterNewUser(lastname, _ ' last name
usridpath, _ '"C:\IBM\Domino\data\ +name+.id" ' file to be created
mailsvr, _ '"mailsvr/bdy" ' mail server
firstname, _ ' ' first name
middleInit, _ ' ' middle initial
certpasswd, _ '"office" ' certifier password
"", _ ' location field
"", _ ' comment field
mailfile, _ '"mail\person.nsf" ' mail file
"", _ ' Forwarding domain
userpasswd, _ '"password", _ ' user password
NOTES_DESKTOP_CLIENT) ' user type
Dim acl As NotesACL
Dim aclEntry As NotesACLEntry
Dim dbUser As NotesDatabase
Set dbUser = New NotesDatabase(mailsvr,mailfile) ' mail/person.nsf
Set acl = dbUser.aCL
Set aclEntry = acl.Getentry( "LocalDomainAdmins" )
If Not (aclEntry Is Nothing) Then
aclEntry.UserType = ACLTYPE_PERSON_GROUP
Call acl.Save()
End If
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Print "Please wait ...... accessing address book"
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(doc.SelectMail(0),True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Print "Force user change password is updated"
Call docUser.Save( True, True, True ) ' save the document
Print "Please wait ...... address book in been updated"
Print "Register user agent ended....."
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
添加 [Mailreplicaservers] 的新脚本
Sub Initialize
On Error GoTo ErrorHandler
Print "Register user agent started....."
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim groups
groups = Null
groups = group(groups,"Everyone")
' groups = group(groups,"Sales & Marketing PR Approval Team")
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailsvr2 As string
Dim mailfile As String
'Dim mailfile2 As String
Dim userpasswd As String
Dim internetpathLength As String
Dim internetpath As String
Dim remapuserID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0) ' full path of cert id
certpasswd = depdoc.IdPassword(0) ' Cert id password(password)
OU = "" 'depdoc.Dept(0) ' Application (department to register)
lastname= doc.Name(0) ' current document selected mail (person)
firstname = "" ' [din't used]
middleinit = "" ' [din't used]
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id" ' user path
' remove "." replace with empty and remove the empty space
remapuserID = remapChr(doc.SelectMail(0)) ' this is remapuserID
mailsvr = depdoc.MailSvr(0) ' mail svr
mailsvr2 = depdoc.MailSvr2(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+ remapuserID ' Mail\Person
' mailfile2 = depdoc.MailLocation2(0)+ remapuserID ' Mail\Person
userpasswd= depdoc.UserPassword(0) ' User password
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
internetpathLength = Len(depdoc.InternetPath(0)) ' not used
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr '"CN=ServerOne/O=dev"
reg.Mailreplicaservers = mailsvr2
reg.CreateMailDb = True '
reg.CertifierIDFile = certid '"C:\IBM\Domino\data\office.id"
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1 ' password strength
reg.IsNorthAmerican = True
reg.OrgUnit = OU ' "" empty ..will just follow certid registration
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.Storeidinaddressbook = False
reg.MailInternetAddress = internetpath '"desmond@devsv1.pcs.com.my"
reg.Shortname=doc.SelectMail(0) ' 'Set shortname []
reg.Mailowneraccess =2 ' '[editor access]
reg.Mailcreateftindex=True ' '[Indexing]
' "CN=Lotus Administrator/O=Notes85"
reg.Mailaclmanager ="LocalDomainAdmins" ' 'Add person into mail acl
reg.Grouplist=groups ' 'Everyone and allstaff
' reg.Mailreplicaservers
Call reg.RegisterNewUser(lastname, _ ' last name
usridpath, _ '"C:\IBM\Domino\data\ +name+.id" ' file to be created
mailsvr, _ '"CN=ServerOne/O=dev" ' mail server
mailsvr2, _ '"CN=ServerTwo/O=dev" ' replicate server
firstname, _ ' ' first name
middleInit, _ ' ' middle initial
certpasswd, _ '"office" ' certifier password
"", _ ' location field
"", _ ' comment field
mailfile, _ '"mail\person.nsf" ' mail file
"", _ ' Forwarding domain
userpasswd, _ '"password", _ ' user password
NOTES_DESKTOP_CLIENT) ' user type
Dim acl As NotesACL
Dim aclEntry As NotesACLEntry
Dim dbUser As NotesDatabase
Set dbUser = New NotesDatabase(mailsvr,mailfile) ' mail/person.nsf
Set acl = dbUser.aCL
Set aclEntry = acl.Getentry( "LocalDomainAdmins" )
If Not (aclEntry Is Nothing) Then
aclEntry.UserType = ACLTYPE_PERSON_GROUP
Call acl.Save()
End If
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Print "Please wait ...... accessing address book"
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(doc.SelectMail(0),True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Print "Force user change password is updated"
Call docUser.Save( True, True, True ) ' save the document
Print "Please wait ...... address book in been updated"
Print "Register user agent ended....."
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
它给我一个类型不匹配的错误，行中的类型不匹配
用户注册完成后，您可以执行以下操作之一：
1)打开邮件文件，使用NotesDatabase.CreateReplica方法
2) 使用NotesAdministrationProcess.CreateReplica方法
确定：您发现了“NotesRegistration”class...
IBM（现为HCL）的文档非常好。只需检查命名为 class，您就会发现 属性 MailReplicaServers:
Defined in
NotesRegistration
Data type
Array of type String
Syntax
To get: variant = notesRegistration .MailReplicaServers
To set: notesRegistration . MailReplicaServers = variant
Usage
Optionally set this property before calling RegisterNewUser.
注意：MailReplicaServers 是一个 VARIANT，它希望传递一个数组，而不是单个值。你可以这样做：
Dim mailservers(0) as String
mailservers(0)=mailsvr2
reg.Mailreplicaservers = mailservers
或者从你的第二个例子中更容易：
reg.Mailreplicaservers = depdoc.MailSvr2
因为 depdoc.MailSvr2 已经是一个只有一个条目的数组。
客户有两个邮件服务器，它们是：
mailsvr1/bdy
mailsvr2/bdy
问题: 客户希望使用一个应用程序来注册笔记帐户。目前我只能用一个电子邮件帐户注册一个笔记帐户，我不知道如何创建一个副本邮件到另一台服务器。但是我去notesregistration那里有创建副本邮件到另一台服务器的功能
On Error GoTo ErrorHandler
Print "Register user agent started....."
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim groups
groups = Null
groups = group(groups,"Everyone")
' groups = group(groups,"Sales & Marketing PR Approval Team")
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailfile As String
Dim userpasswd As String
Dim internetpathLength As String
Dim internetpath As String
Dim remapuserID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0) ' full path of cert id
certpasswd = depdoc.IdPassword(0) ' Cert id password(password)
OU = "" 'depdoc.Dept(0) ' Application (department to register)
lastname= doc.Name(0) ' current document selected mail (person)
firstname = "" ' [din't used]
middleinit = "" ' [din't used]
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id" ' user path
' remove "." replace with empty and remove the empty space
remapuserID = remapChr(doc.SelectMail(0)) ' this is remapuserID
mailsvr = depdoc.MailSvr(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+ remapuserID ' Mail\Person
userpasswd= depdoc.UserPassword(0) ' User password
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
internetpathLength = Len(depdoc.InternetPath(0)) ' not used
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr '"mailsvr/bdy"
reg.CreateMailDb = True '
reg.CertifierIDFile = certid '"C:\IBM\Domino\data\office.id"
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1 ' password strength
reg.IsNorthAmerican = True
reg.OrgUnit = OU ' "" empty ..will just follow certid registration
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.Storeidinaddressbook = False
reg.MailInternetAddress = internetpath '"desmond@devsv1.pcs.com.my"
reg.Shortname=doc.SelectMail(0) ' 'Set shortname []
reg.Mailowneraccess =2 ' '[editor access]
reg.Mailcreateftindex=True ' '[Indexing]
' "CN=Lotus Administrator/O=Notes85"
reg.Mailaclmanager ="LocalDomainAdmins" ' 'Add person into mail acl
reg.Grouplist=groups ' 'Everyone and allstaff
Call reg.RegisterNewUser(lastname, _ ' last name
usridpath, _ '"C:\IBM\Domino\data\ +name+.id" ' file to be created
mailsvr, _ '"mailsvr/bdy" ' mail server
firstname, _ ' ' first name
middleInit, _ ' ' middle initial
certpasswd, _ '"office" ' certifier password
"", _ ' location field
"", _ ' comment field
mailfile, _ '"mail\person.nsf" ' mail file
"", _ ' Forwarding domain
userpasswd, _ '"password", _ ' user password
NOTES_DESKTOP_CLIENT) ' user type
Dim acl As NotesACL
Dim aclEntry As NotesACLEntry
Dim dbUser As NotesDatabase
Set dbUser = New NotesDatabase(mailsvr,mailfile) ' mail/person.nsf
Set acl = dbUser.aCL
Set aclEntry = acl.Getentry( "LocalDomainAdmins" )
If Not (aclEntry Is Nothing) Then
aclEntry.UserType = ACLTYPE_PERSON_GROUP
Call acl.Save()
End If
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Print "Please wait ...... accessing address book"
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(doc.SelectMail(0),True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Print "Force user change password is updated"
Call docUser.Save( True, True, True ) ' save the document
Print "Please wait ...... address book in been updated"
Print "Register user agent ended....."
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
添加 [Mailreplicaservers] 的新脚本
Sub Initialize
On Error GoTo ErrorHandler
Print "Register user agent started....."
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim groups
groups = Null
groups = group(groups,"Everyone")
' groups = group(groups,"Sales & Marketing PR Approval Team")
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailsvr2 As string
Dim mailfile As String
'Dim mailfile2 As String
Dim userpasswd As String
Dim internetpathLength As String
Dim internetpath As String
Dim remapuserID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0) ' full path of cert id
certpasswd = depdoc.IdPassword(0) ' Cert id password(password)
OU = "" 'depdoc.Dept(0) ' Application (department to register)
lastname= doc.Name(0) ' current document selected mail (person)
firstname = "" ' [din't used]
middleinit = "" ' [din't used]
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id" ' user path
' remove "." replace with empty and remove the empty space
remapuserID = remapChr(doc.SelectMail(0)) ' this is remapuserID
mailsvr = depdoc.MailSvr(0) ' mail svr
mailsvr2 = depdoc.MailSvr2(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+ remapuserID ' Mail\Person
' mailfile2 = depdoc.MailLocation2(0)+ remapuserID ' Mail\Person
userpasswd= depdoc.UserPassword(0) ' User password
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
internetpathLength = Len(depdoc.InternetPath(0)) ' not used
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr '"CN=ServerOne/O=dev"
reg.Mailreplicaservers = mailsvr2
reg.CreateMailDb = True '
reg.CertifierIDFile = certid '"C:\IBM\Domino\data\office.id"
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1 ' password strength
reg.IsNorthAmerican = True
reg.OrgUnit = OU ' "" empty ..will just follow certid registration
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.Storeidinaddressbook = False
reg.MailInternetAddress = internetpath '"desmond@devsv1.pcs.com.my"
reg.Shortname=doc.SelectMail(0) ' 'Set shortname []
reg.Mailowneraccess =2 ' '[editor access]
reg.Mailcreateftindex=True ' '[Indexing]
' "CN=Lotus Administrator/O=Notes85"
reg.Mailaclmanager ="LocalDomainAdmins" ' 'Add person into mail acl
reg.Grouplist=groups ' 'Everyone and allstaff
' reg.Mailreplicaservers
Call reg.RegisterNewUser(lastname, _ ' last name
usridpath, _ '"C:\IBM\Domino\data\ +name+.id" ' file to be created
mailsvr, _ '"CN=ServerOne/O=dev" ' mail server
mailsvr2, _ '"CN=ServerTwo/O=dev" ' replicate server
firstname, _ ' ' first name
middleInit, _ ' ' middle initial
certpasswd, _ '"office" ' certifier password
"", _ ' location field
"", _ ' comment field
mailfile, _ '"mail\person.nsf" ' mail file
"", _ ' Forwarding domain
userpasswd, _ '"password", _ ' user password
NOTES_DESKTOP_CLIENT) ' user type
Dim acl As NotesACL
Dim aclEntry As NotesACLEntry
Dim dbUser As NotesDatabase
Set dbUser = New NotesDatabase(mailsvr,mailfile) ' mail/person.nsf
Set acl = dbUser.aCL
Set aclEntry = acl.Getentry( "LocalDomainAdmins" )
If Not (aclEntry Is Nothing) Then
aclEntry.UserType = ACLTYPE_PERSON_GROUP
Call acl.Save()
End If
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Print "Please wait ...... accessing address book"
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(doc.SelectMail(0),True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Print "Force user change password is updated"
Call docUser.Save( True, True, True ) ' save the document
Print "Please wait ...... address book in been updated"
Print "Register user agent ended....."
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
它给我一个类型不匹配的错误，行中的类型不匹配
用户注册完成后，您可以执行以下操作之一：
1)打开邮件文件，使用NotesDatabase.CreateReplica方法
2) 使用NotesAdministrationProcess.CreateReplica方法
确定：您发现了“NotesRegistration”class...
IBM（现为HCL）的文档非常好。只需检查命名为 class，您就会发现 属性 MailReplicaServers:
Defined in
NotesRegistrationData type
Array of type StringSyntax
To get: variant = notesRegistration .MailReplicaServersTo set: notesRegistration . MailReplicaServers = variant
Usage
Optionally set this property before calling RegisterNewUser.
注意：MailReplicaServers 是一个 VARIANT，它希望传递一个数组，而不是单个值。你可以这样做：
Dim mailservers(0) as String
mailservers(0)=mailsvr2
reg.Mailreplicaservers = mailservers
或者从你的第二个例子中更容易：
reg.Mailreplicaservers = depdoc.MailSvr2
因为 depdoc.MailSvr2 已经是一个只有一个条目的数组。