Tags
Infos
Alors admettons que justement vous ayez besoin de mettre à jour une de ces fameuses listes de diffusion à partir d’un fichier csv que l’on vient de vous transmettre en pièce jointe d’un petit mail…
« Ça serait sympa si t’avais 2 min pour mettre à jour cette liste de diff… toute la liste d’abonnés ont été revue… pas loin de 4000 comptes 
d’avance merci @+ »
Et vous voilà fort mari… en constatant qu’il faut saisir les abonnés un par un…
Voici donc un petit script en VB qui va vous sauver la vie :
Option Explicit
Dim objectApp
Dim objectDomain
Dim objectDistributionLists
Dim objectDistributionList
Dim objectjFSO
Dim objectjTextFile
Dim stringNewMailAddress
Const ForReading = 1
Const DOMAIN_NAME = "kaamelott.graal"
Const LIST_NAME = "onenagros"
Const HMSADMINUSER = "Administrator"
Const HMSADMINPWD = "genievre"
Const SENDER_ADDRESS = "arthur@kaamelott.graal"
Const SRC_FILE_NAME = "chevaliersDeLaTableRonde.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)
objectDistributionList.Delete
objectDistributionLists.Refresh
'Creation de la liste avec les memes parametres
Set objectDistributionList = objectDistributionLists.Add
'Address
objectDistributionList.Address = LIST_NAME & "@" & DOMAIN_NAME
'Enabled the list
objectDistributionList.Active = true
'Mode
objectDistributionList.Mode = 2
objectDistributionList.RequireSenderAddress = SENDER_ADDRESS
'Security
objectDistributionList.RequireSMTPAuth = false
objectDistributionList.Save()
objectDistributionLists.Refresh
'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
Set objectDomain = objectApp.Domains.ItemByName(stringDomainName)
Set objectDistributionLists = objectDomain.DistributionLists
Set objectDistributionList = objectDistributionLists.ItemByAddress(stringListName & "@" & stringDomainName)
Set objectRecipients = objectDistributionList.Recipients
Set objectRecipient = objectRecipients.Add()
objectRecipient.RecipientAddress = stringEmailAddress
objectRecipient.Save()
Set objectRecipient = Nothing
Set objectDomain = Nothing
Set objectDistributionLists = Nothing
Set objectDistributionList = Nothing
Set objectRecipients = Nothing
End SubEn fait, au sein de ce script, il n’y a pas de mise à jour, mais suppression de l’ancienne liste, création d’une nouvelle avec des paramètres indentiques et import des nouveaux abonnés [1].
Une méthode plus simple consiterait à modifier directement en base les données de la table " hm_distributionlistsrecipients"
RSS 2.0