Bonjour à tous,
J'ai pu faire un code pour envoyer un mail reprenant des informations de concernant chaque personne dans la liste et lui informant qu'il appartient à tel ou tel groupe.
User: admin
Password: admin
deverrouilage sheet/book: fullcrum
quand on regarde le code, il fait ceci: dans le sheet USERS_CDN et USER_MDN (appel du USERFORM)
1) voir dans la colonne CDN MAIL du sheet USER_CDN l'adresse qui est présente et dnner les informations présentes sur la ligne lui correspondant
2) il va faire un préview de chaque mail pour voir si la mise en forme est bonne... Sauf que tout les mails seront les meme, donc juste voir un seul mail suffit.
3) une fois le préview fait, il faut que TOUT les mails s'envoit, dans mon cas, il faut faire a chacun des mails la validation de l'envois.
4) pour diminuer l'envois multiple, il serait préférable d'avoir un mail avec les memes informations qui sont regroupés dans les destinataires.
Exemple:
User 1 boite yyy
User 2 boite www
User 3 boite xxx
User 4 boite yyy
User 5 boite xxx
Le résultat serait dans destinataire :
user1;user4 reçoivent le mail avec l’info qu’ils appartiennent a la boite yyy
user2 reçoit le mail avec l’info qu’ils appartiennent a la boite www
user3;user5 reçoivent le mail avec l’info qu’ils appartiennent a la boite xxx
Il faut garder aussi le USERFORM
Merci d'avance à tous
J'ai pu faire un code pour envoyer un mail reprenant des informations de concernant chaque personne dans la liste et lui informant qu'il appartient à tel ou tel groupe.
User: admin
Password: admin
deverrouilage sheet/book: fullcrum
VB:
'Ok
Private Sub AddFile1_Click()
Dim Myfilepath As String
Dim MyfilepathExist As String
Myfilepath = Application.GetOpenFilename()
MyfilepathExist = Dir(Myfilepath)
If MyfilepathExist = "" Then
TextBox1.Text = ""
Else
TextBox1.Text = Myfilepath
End If
End Sub
'ok
Private Sub AddFile2_Click()
Dim Myfilepath As String
Dim MyfilepathExist As String
Myfilepath = Application.GetOpenFilename()
MyfilepathExist = Dir(Myfilepath)
If MyfilepathExist = "" Then
TextBox2.Text = ""
Else
TextBox2.Text = Myfilepath
End If
End Sub
'ok
Private Sub AddFile3_Click()
Dim Myfilepath As String
Dim MyfilepathExist As String
Myfilepath = Application.GetOpenFilename()
MyfilepathExist = Dir(Myfilepath)
If MyfilepathExist = "" Then
TextBox3.Text = ""
Else
TextBox3.Text = Myfilepath
End If
End Sub
'Sub Mapping()
'Dim objNetwork, strLocalDrive, strRemoteShare
'Set objNetwork = WScript.CreateObject("WScript.Network")
'strLocalDrive = "T:"
'strRemoteShare = "\\IPCOMMON.value\NAS\Films\"
'objNetwork.MapNetworkDrive strLocalDrive, strRemoteShare, True
'End Sub
Private Sub PreviewMail_Click()
Dim ListeDest() 'variable dans tableau USERS
Dim ListeService() 'variable dans tableau USERS
Dim ListeDistribution() 'variable dans tableau USERS
Dim ListeServiceExtra() 'variable dans tableau USERS
Dim i As Long
Dim Outlookapp As Object
Dim MItem As MailItem
Dim sListeDest As String
Set Outlookapp = CreateObject("outlook.application")
Set Outlookapp = New Outlook.Application
On Error Resume Next
ListeDest() = Range("USERS_CDN[CDN MAIL]") 'variable dans tableau USERS
ListeService() = Range("USERS_CDN[SERVICE MAIL UNCLASS]") 'variable dans tableau USERS
ListeServiceExtra() = Range("USERS_CDN[SERVICE MAIL UNCLASS EXTRA]") 'variable dans tableau USERS
ListeDistribution() = Range("USERS_CDN[DISTRIBUTION LIST UNCLASS]") 'variable dans tableau USERS
For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
If ListeDest(i, 1) = "" Then
GoTo nextI
End If
Set MItem = Outlookapp.CreateItem(olMailItem) 'create new mail
With MItem
.SentOnBehalfOfName = TextBoxFrom.Text
.To = ListeDest(i, 1)
If FR.Value Then .Subject = .Subject & Worksheets("Mail").Range("B4") & "/"
If NL.Value Then .Subject = .Subject & Worksheets("Mail").Range("B8") & "/"
If EN.Value Then .Subject = .Subject & Worksheets("Mail").Range("B12")
'BODY
If FR.Value Then
.Body = TEST
.Body = .Body & Worksheets("Mail").Range("B5") & Chr(10) & Chr(13) & "Vous avez été ajouté à la boite de service suivante: " & ListeService(i, 1) & Chr(10) & Chr(13) & "Vous avez été ajouté à la boite de service supplémentaire suivante: " & ListeServiceExtra(i, 1) & Chr(10) & Chr(13) & "Vous appartenez à la liste de distribution suivante: " & ListeDistribution(i, 1) & Chr(10) & Chr(13)
'COMMON
If COMMON_BOX.Value Then
.Body = .Body & "L'addresse du NAS (COMMON) est: \\" & IPCOMMON.Value & "\COMMON\" & Chr(10) & Chr(13)
End If
'Signature
If FR.Value Then
.Body = .Body & "CIS TEAM" & Chr(10) & Chr(13) & "------------------------------------------------------------------------------------------------------------------------------"
End If
End If
'BODY
If NL.Value Then
.Body = .Body & Worksheets("Mail").Range("B9") & Chr(10) & Chr(13) & "U bent toegevoegd aan de volgende servicebox: " & ListeService(i, 1) & Chr(10) & Chr(13) & "U bent toegevoegd aan de volgende aanvullende servicebox: " & ListeServiceExtra(i, 1) & Chr(10) & Chr(13) & "U behoort tot de volgende distributielijst: " & ListeDistribution(i, 1) & Chr(10) & Chr(13)
'COMMON
If COMMON_BOX.Value Then
.Body = .Body & "Het adres van de NAS (COMMON) is: \\" & IPCOMMON.Value & "\COMMON\" & Chr(10) & Chr(13)
End If
'Signature
If NL.Value Then
.Body = .Body & "CIS TEAM" & Chr(10) & Chr(13) & "------------------------------------------------------------------------------------------------------------------------------"
End If
End If
'BODY
If EN.Value Then
.Body = .Body & Worksheets("Mail").Range("B13") & Chr(10) & Chr(13) & "You have been added to the following service box: " & ListeService(i, 1) & Chr(10) & Chr(13) & "You have been added to the following additional service box: " & ListeServiceExtra(i, 1) & Chr(10) & Chr(13) & "You belong to the following distribution list: " & ListeDistribution(i, 1) & Chr(10) & Chr(13)
'COMMON
If COMMON_BOX.Value Then
.Body = .Body & "The address of the NAS (COMMON) is: \\" & IPCOMMON.Value & "\COMMON\" & Chr(10) & Chr(13)
End If
'Signature
If EN.Value Then
.Body = .Body & "CIS TEAM" & Chr(10) & Chr(13) & "------------------------------------------------------------------------------------------------------------------------------"
End If
End If
If TextBox1.Value <> "" Then .Attachments.Add (Me.TextBox1.Value)
If TextBox2.Value <> "" Then .Attachments.Add (Me.TextBox2.Value)
If TextBox3.Value <> "" Then .Attachments.Add (Me.TextBox3.Value)
.Display
End With
Set MItem = Nothing
GoTo Endsub
nextI:
Next
Endsub:
End Sub
'ok
Private Sub RemoveFile1_Click()
TextBox1.Text = ""
End Sub
'ok
Private Sub RemoveFile2_Click()
TextBox2.Text = ""
End Sub
'ok
Private Sub RemoveFile3_Click()
TextBox3.Text = ""
End Sub
'ok
Private Sub SendMail_Click()
Dim ListeDest() 'variable dans tableau USERS
Dim ListeService() 'variable dans tableau USERS
Dim ListeDistribution() 'variable dans tableau USERS
Dim ListeServiceExtra() 'variable dans tableau USERS
Dim i As Long
Dim Outlookapp As Object
Dim MItem As MailItem
Dim sListeDest As String
Set Outlookapp = CreateObject("outlook.application")
Set Outlookapp = New Outlook.Application
On Error Resume Next
ListeDest() = Range("USERS_CDN[CDN MAIL]") 'variable dans tableau USERS
ListeService() = Range("USERS_CDN[SERVICE MAIL UNCLASS]") 'variable dans tableau USERS
ListeServiceExtra() = Range("USERS_CDN[SERVICE MAIL UNCLASS EXTRA]") 'variable dans tableau USERS
ListeDistribution() = Range("USERS_CDN[DISTRIBUTION LIST UNCLASS]") 'variable dans tableau USERS
For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
If ListeDest(i, 1) = "" Then
GoTo nextI
End If
Set MItem = Outlookapp.CreateItem(olMailItem) 'create new mail
With MItem
.SentOnBehalfOfName = TextBoxFrom.Text
.To = ListeDest(i, 1)
If FR.Value Then .Subject = .Subject & Worksheets("Mail").Range("B4") & "/"
If NL.Value Then .Subject = .Subject & Worksheets("Mail").Range("B8") & "/"
If EN.Value Then .Subject = .Subject & Worksheets("Mail").Range("B12")
'BODY
If FR.Value Then
.Body = .Body & Worksheets("Mail").Range("B5") & Chr(10) & Chr(13) & "Vous avez été ajouté à la boite de service suivante: " & ListeService(i, 1) & Chr(10) & Chr(13) & "Vous avez été ajouté à la boite de service supplémentaire suivante: " & ListeServiceExtra(i, 1) & Chr(10) & Chr(13) & "Vous appartenez à la liste de distribution suivante: " & ListeDistribution(i, 1) & Chr(10) & Chr(13)
'COMMON
If COMMON_BOX.Value Then
.Body = .Body & "L'addresse du NAS (COMMON) est: \\" & IPCOMMON.Value & "\COMMON\" & Chr(10) & Chr(13)
End If
'Signature
If FR.Value Then
.Body = .Body & "CIS TEAM" & Chr(10) & Chr(13) & "------------------------------------------------------------------------------------------------------------------------------"
End If
End If
'BODY
If NL.Value Then
.Body = .Body & Worksheets("Mail").Range("B9") & Chr(10) & Chr(13) & "U bent toegevoegd aan de volgende servicebox: " & ListeService(i, 1) & Chr(10) & Chr(13) & "U bent toegevoegd aan de volgende aanvullende servicebox: " & ListeServiceExtra(i, 1) & Chr(10) & Chr(13) & "U behoort tot de volgende distributielijst: " & ListeDistribution(i, 1) & Chr(10) & Chr(13)
'COMMON
If COMMON_BOX.Value Then
.Body = .Body & "Het adres van de NAS (COMMON) is: \\" & IPCOMMON.Value & "\COMMON\" & Chr(10) & Chr(13)
End If
'Signature
If NL.Value Then
.Body = .Body & "CIS TEAM" & Chr(10) & Chr(13) & "------------------------------------------------------------------------------------------------------------------------------"
End If
End If
'BODY
If EN.Value Then
.Body = .Body & Worksheets("Mail").Range("B13") & Chr(10) & Chr(13) & "You have been added to the following service box: " & ListeService(i, 1) & Chr(10) & Chr(13) & "You have been added to the following additional service box: " & ListeServiceExtra(i, 1) & Chr(10) & Chr(13) & "You belong to the following distribution list: " & ListeDistribution(i, 1) & Chr(10) & Chr(13)
'COMMON
If COMMON_BOX.Value Then
.Body = .Body & "The address of the NAS (COMMON) is: \\" & IPCOMMON.Value & "\COMMON\" & Chr(10) & Chr(13)
End If
'Signature
If EN.Value Then
.Body = .Body & "CIS TEAM" & Chr(10) & Chr(13) & "------------------------------------------------------------------------------------------------------------------------------"
End If
End If
If TextBox1.Value <> "" Then .Attachments.Add (Me.TextBox1.Value)
If TextBox2.Value <> "" Then .Attachments.Add (Me.TextBox2.Value)
If TextBox3.Value <> "" Then .Attachments.Add (Me.TextBox3.Value)
BoxPreviewMsg = MsgBox("would you like to see the email before sending", vbQuestion + vbYesNoCancel + vbDefaultButton2, "Preview?")
If BoxPreviewMsg = vbYes Then
.Display
ElseIf BoxPreviewMsg = vbNo Then
.Send
ElseIf BoxPreviewMsg = vbCancel Then
Exit Sub
End If
'.Send
End With
Set MItem = Nothing
nextI:
Next
End Sub
'ok
Private Sub Cancel_Click()
Unload Me
End Sub
quand on regarde le code, il fait ceci: dans le sheet USERS_CDN et USER_MDN (appel du USERFORM)
1) voir dans la colonne CDN MAIL du sheet USER_CDN l'adresse qui est présente et dnner les informations présentes sur la ligne lui correspondant
2) il va faire un préview de chaque mail pour voir si la mise en forme est bonne... Sauf que tout les mails seront les meme, donc juste voir un seul mail suffit.
3) une fois le préview fait, il faut que TOUT les mails s'envoit, dans mon cas, il faut faire a chacun des mails la validation de l'envois.
4) pour diminuer l'envois multiple, il serait préférable d'avoir un mail avec les memes informations qui sont regroupés dans les destinataires.
Exemple:
User 1 boite yyy
User 2 boite www
User 3 boite xxx
User 4 boite yyy
User 5 boite xxx
Le résultat serait dans destinataire :
user1;user4 reçoivent le mail avec l’info qu’ils appartiennent a la boite yyy
user2 reçoit le mail avec l’info qu’ils appartiennent a la boite www
user3;user5 reçoivent le mail avec l’info qu’ils appartiennent a la boite xxx
Il faut garder aussi le USERFORM
Merci d'avance à tous