hMailServer : distribution lists - Part III

Option Explicit



Dim objectApp

Dim objectDomain

Dim objectDistributionLists

Dim objectDistributionList

Dim objectjFSO

Dim objectjTextFile

Dim stringNewMailAddress



Const ForReading = 1

'Domaine auquel la liste appartient 

Const DOMAIN_NAME = "kaamelott.graal"

'Nom de la liste

Const LIST_NAME = "onenagros"

'Identifiant superutilisateur hMaiServer 

Const HMSADMINUSER = "Administrator"

'Mot de passe  superutilisateur hMaiServer 

Const HMSADMINPWD = "genievre"

'Fichier source des adresses à traiter

Const SRC_FILE_NAME = "ChevaliersDeLaTableRondePartisAlaTaverne.csv"



'Initialisation

Set objectApp = Createobject("hMailServer.Application")



'Authentification

Call objectApp.Authenticate(HMSADMINUSER, HMSADMINPWD)



'Suppression de la liste

Set objectDomain = objectApp.Domains.ItemByName(DOMAIN_NAME)

Set objectDistributionLists = objectDomain.DistributionLists

Set objectDistributionList = objectDistributionLists.ItemByAddress(LIST_NAME & "@" & DOMAIN_NAME)



'Lecture du fichier csv source contenant la liste des abonnes

Set objectjFSO = Createobject("Scripting.FileSystemobject")

Set objectjTextFile = objectjFSO.OpenTextFile(SRC_FILE_NAME, ForReading)



Do While objectjTextFile.AtEndOfStream <> True

   stringNewMailAddress = objectjTextFile.Readline

   If objectApp.Utilities.IsValidEmailAddress(stringNewMailAddress) Then

        'Si la chaine de caractere est bien une adresse mail on ajoute

         AddRecipient stringNewMailAddress, LIST_NAME, DOMAIN_NAME

   End If

Loop



objectjTextFile.Close



'Message de fin on affiche le nombre total des abonnes

WScript.Echo LIST_NAME & "@" & DOMAIN_NAME & " : " & objectDistributionList.Recipients.Count & " subscribers"

WScript.Quit

   

'Fonction de creation de compte abonne

Sub AddRecipient(stringEmailAddress, stringListName, stringDomainName)

  Dim objectDomain

  Dim objectDistributionLists

  Dim objectDistributionList

  Dim objectRecipient

  Dim objectRecipients

  Dim integerQuantityOfRecipients

  Dim i 

  Dim recipientInList 

  

  recipientInList = 0

  Set objectDomain = objectApp.Domains.ItemByName(stringDomainName)

  Set objectDistributionLists = objectDomain.DistributionLists

  Set objectDistributionList = objectDistributionLists.ItemByAddress(stringListName & "@" & stringDomainName)

  Set objectRecipients = objectDistributionList.Recipients

  integerQuantityOfRecipients = objectRecipients.Count

   

  For i = 0 To integerQuantityOfRecipients-1

      If stringEmailAddress = objectRecipients(i).RecipientAddress Then

         recipientInList = objectRecipients(i).ID

         Exit For

      End If

  Next

  

  If  recipientInList > 0 Then

      objectRecipients.DeleteByDBID(recipientInList)

      WScript.Echo stringEmailAddress & " supprimé de la liste !"

  Else

      WScript.Echo stringEmailAddress & " non trouvé dans la liste !"

  End If

  

  Set objectRecipient = Nothing

  Set objectDomain = Nothing

  Set objectDistributionLists = Nothing  

  Set objectDistributionList = Nothing

  Set objectRecipients = Nothing

End Sub
hMailServer : distribution lists - Part III

P.-S.

Rubriques

Dans la même rubrique

Mots-clés
