MOTOBIT.COMSome support VBA functions for mailenable mail server

Option Explicit

'Add functions - add one email address.
' adds postoffice, mailbox, login And maps email address
Public Function AddFullEmail(ByRef Email As String, _
  ByRef Password As String) As Long
  
  Dim UserName As String, Domain As String
  Domain = Split(Email, "@")(1)
  UserName = Split(Email, "@")(0)

  Dim result As Long
  result = CreatePostOffice(Domain)
  If result <> 0 Then result = AddDoaminToPostOffice(Domain)
  If result <> 0 Then result = AddMailBoxToPostOffice(Domain, UserName)
  If result <> 0 Then result = AddLogin(Domain, UserName, Password)
  If result <> 0 Then result = AddEmail(Domain, UserName, Email)
  AddFullEmail = result
End Function

Function CreatePostOffice(ByRef name As String) As Long
  Dim lResult As Long
  Dim PostOffice As New MEAOPO.PostOffice
  'Set PostOffice = CreateObject("MEAOPO.Postoffice")
  
  With PostOffice
    .name = name
    .Host = name
    .Account = name
    .Status = 1
    'Try To get existing postoffice
    lResult = .GetPostoffice()
    If lResult = 0 Then 'create the postoffice
      lResult = .AddPostoffice()
    Else 'Postoffice already exists.
      lResult = -1
    End If
  End With
  CreatePostOffice = lResult
End Function

'Adds domain To postoffice
Function AddDoaminToPostOffice(ByRef PostOffice As String, _
  Optional ByVal DomainName As String = "") As Long
  If Len(DomainName) = 0 Then DomainName = PostOffice
  
  Dim lResult As Long
  Dim oDomain As New MEAOSM.Domain
  'Set oDomain = CreateObject("MEAOSM.Domain")
  
  With oDomain
    .AccountName = PostOffice
    .DomainName = DomainName
    .Status = 1
    'try To get existing domain.
    lResult = .GetDomain
    If lResult = 0 Then 'create the postoffice
      lResult = .AddDomain
    Else 'Postoffice already exists.
      lResult = -1
    End If
  End With
  AddDoaminToPostOffice = lResult
End Function
          

'Adds mailbox To postoffice
Function AddMailBoxToPostOffice(ByRef PostOffice As String, _
  ByRef UserName As String, _
  Optional ByVal Limit As Long = -1) As Long
  
  
  Dim lResult As Long
  Dim oMailbox As New MEAOPO.Mailbox
  'Set oMailbox = CreateObject("MEAOPO.Mailbox")

  With oMailbox
    .PostOffice = PostOffice
    .Mailbox = UserName
    .RedirectAddress = ""
    .RedirectStatus = 0
    .Status = 1
    
    'try To get existing Mailbox.
    lResult = .GetMailbox
    If lResult = 0 Then 'create the Mailbox
      .Limit = Limit
      lResult = .AddMailbox()
    Else 'Mailbox already exists.
      lResult = -1
    End If
  End With
  AddMailBoxToPostOffice = lResult
End Function
      
      
'Adds Login To postoffice
Function AddLogin(ByRef PostOffice As String, _
  ByRef UserName As String, ByRef Password As String) As Long
  
  
  Dim lResult As Long
  Dim oAUTHLogin As New MEAOAU.Login
  'Set oAUTHLogin = CreateObject("MEAOAU.Login")

  'when we create a mailbox we also create a pop logon
  With oAUTHLogin
    .Account = PostOffice
    .UserName = UserName & "@" & PostOffice
    .Status = 1
    .Description = ""
    .Host = ""
    .Rights = "USER"
    
    'try To get existing login.
    lResult = .GetLogin()
    If lResult = 0 Then 'create the login
      .Password = Password
      lResult = .AddLogin()
    Else 'login already exists.
      lResult = -1
    End If
  End With
  AddLogin = lResult
End Function
      
'Adds domain To postoffice
Function AddEmail(ByRef PostOffice As String, _
  ByRef UserName As String, ByRef Email As String) As Long
  
  Dim lResult As Long
  Dim oAddressMap As New MEAOAM.AddressMap
'  Set oAddressMap = CreateObject("MEAOAM.AddressMap")

  With oAddressMap
    Dim varTemp
    
    .Account = PostOffice
    .DestinationAddress = "[SF:" & PostOffice & "/" & UserName & "]"
    .Scope = "[SMTP:" & Email & "]"
    .SourceAddress = "[SMTP:" & Email & "]"
    
    'try To get existing email address.
    lResult = .GetAddressMap
    If lResult = 0 Then 'create a new email address map
      lResult = .AddAddressMap()
    Else 'email address already exists.
      lResult = -1
    End If
  End With
  AddEmail = lResult
End Function
      





'****************** control functions **********************
'retrieves a password from an email address (username@postoffice)
Public Function GetPassword(ByRef Email As String) As String
  Dim oLogin
  Set oLogin = GetoLogin("" & Split(Email, "@")(1), _
    "" & Split(Email, "@")(0))
  GetPassword = oLogin.Password
End Function

'checks If the login/account is created.
Public Function ExistsLogin(ByRef Email As String) As Boolean
  ExistsLogin = IsObject(GetoLogin("" & Split(Email, "@")(1), _
    "" & Split(Email, "@")(0)))
End Function

'Returns a login object
Function GetoLogin(ByRef PostOffice As String, _
  ByRef UserName As String)
  
  Dim lResult As Long
  Dim oAUTHLogin As New MEAOAU.Login
  'Set oAUTHLogin = CreateObject("MEAOAU.Login")

  With oAUTHLogin
    .Account = PostOffice
    .UserName = UserName & "@" & PostOffice
    .Status = 1
    .Description = ""
    .Host = ""
    .Rights = "USER"
    
    'try To get existing login.
    lResult = .GetLogin()
    If lResult <> 0 Then 'create the login
      Set GetoLogin = oAUTHLogin
    End If
  End With
End Function

'checks If the email address is mapped To an account.
Public Function ExistsEmail(ByRef Email As String) As Boolean
  Dim lResult As Long
  Dim oAddressMap As New MEAOAM.AddressMap
'  Set oAddressMap = CreateObject("MEAOAM.AddressMap")
  
  Dim PostOffice As String
  PostOffice = Split(Email, "@")(1)
  With oAddressMap
    Dim varTemp
    
    .Account = PostOffice
    .SourceAddress = "[SMTP:" & Email & "]"
    
    'try To get existing address.
    lResult = .GetAddressMap
    ExistsEmail = lResult <> 0
  End With
End Function

Copyright and use this code

<A
 Href="http://www.motobit.com/tips/detpg_mailenable-support/"
 Title="Lets you create postoffice, mailboxes, logins,
	email adresses from VBA or
	VBScript."
>Some support VBA functions for mailenable mail server</A>