M
Membre supprimé 156683
Guest
Bonjour à tous,
J'ai réalisé une macro Excel permettant de générer un mail suivant un tableau et les adresses sélectionnées par le User ;
Sub test()
Dim AppOut As Object
Dim oMailItem As Object
Dim Template As String
Dim Plage As Range
Dim Cellule1 As Object
Dim Cellule2 As Object
Dim K, L, M, N
courant = ThisWorkbook.Name
Set Plage = Application.InputBox("À", "SÉLECTION", Type:=8)
For Each Cellule1 In Plage
K = Range(Cellule1.Address).Value
Next Cellule1
Set Plage = Application.InputBox("Cc:", "SÉLECTION", Type:=8)
For Each Cellule2 In Plage
L = Range(Cellule2.Address).Value
Next Cellule2
'name
Windows(courant).Activate
For Each cell In Range("A1:A15")
If cell.Value = "Name" Then
M = cell.Offset(0, 1).Value
End If
Next
For Each cell In Range("A1:A15")
If cell.Value = "WB" Then
N = cell.Offset(0, 1).Value
End If
Next
Set AppOut = CreateObject("Outlook.Application")
Set oMailItem = AppOut.CreateItem(olMailItem)
With oMailItem
.To = K
.CC = L
.Subject = ActiveWorkbook.ActiveSheet.Name & " - " & M & " documents distribution"
.HTMLBody = "<HTML>Dear Sirs and Madams,<BODY><br><br>"
.HTMLBody = oMailItem.HTMLBody & "Please be informed that the documents delivered from " & M
.HTMLBody = oMailItem.HTMLBody & " to CPC :<br><br>"
.HTMLBody = oMailItem.HTMLBody & "for :"
.HTMLBody = oMailItem.HTMLBody & "<br><br><br><br>are available into " & N
.HTMLBody = oMailItem.HTMLBody & "<br><br><font color=red><H4>Please let us know if you notice some mistakes </font></H4>"
.HTMLBody = oMailItem.HTMLBody & "Regards,"
.Display
End With
End Sub
Mon code fonctionne parfaitement, le seul problème est un message intempestif qui apparait lorsque la macro créé le mail :
"Un programme tente d'accéder à des données Outlook, parmi lesquelles peuvent se trouver des informations du carnet d'adresse. L'autorisez vous à poursuivre ? "
J’ai trouvé pas mal de tips comme installer un soft supplémentaire (comme Clickyes)
Mais cela ne me convient pas car chaque utilisateur devrait l’installer.
De plus vu que j’ai OUTLOOK 2003 SP2, je ne peux pas simplement décocher « M’avertir lorsque qu’une source tiers essaie d’envoyer un email » dans l’onglet sécurité => ce n’est valable que pour outlook express.
Donc j’aimerais un 2ème regard sur mon code pr éviter ce message : il me semble qu’il faut pas créé un mail mais en générer un nouveau quand outlook est ouvert mais je n’y arrive pas sans avoir des erreurs « objet requis », « bloc with », etc…
Ma deuxième question concerne la signature en bas de chaque mail généré :
J’aimerais que la signature propre de chaque user puisse se mettre à la fin de chaque mail généré (peut être que la résolution de mon premier problème résoudra ce problème)
J’ai trouvé sur le forum ceci :
Public Function recuptxt(chemin As String)
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(chemin).OpenAsTextStream(1, -2)
recuptxt = ts.readall
ts.Close
End Function
.HTMLBody = oMailItem.HTMLBody & recuptxt("C:\Documents and Settings\(username)\Application Data\Microsoft\Signatures\(signature).txt")
Qui fonctionne très bien mais comment mettre le username et le nom de la signature.txt de manière dynamique car pour que ce chemin fonctionne il faut préciser le nom du user et celui de la signture mais comme cette macro sera utiliser par plusieurs personnes, ce n’est le mm nom ni signature.
Cordialement,
M&m
J'ai réalisé une macro Excel permettant de générer un mail suivant un tableau et les adresses sélectionnées par le User ;
Sub test()
Dim AppOut As Object
Dim oMailItem As Object
Dim Template As String
Dim Plage As Range
Dim Cellule1 As Object
Dim Cellule2 As Object
Dim K, L, M, N
courant = ThisWorkbook.Name
Set Plage = Application.InputBox("À", "SÉLECTION", Type:=8)
For Each Cellule1 In Plage
K = Range(Cellule1.Address).Value
Next Cellule1
Set Plage = Application.InputBox("Cc:", "SÉLECTION", Type:=8)
For Each Cellule2 In Plage
L = Range(Cellule2.Address).Value
Next Cellule2
'name
Windows(courant).Activate
For Each cell In Range("A1:A15")
If cell.Value = "Name" Then
M = cell.Offset(0, 1).Value
End If
Next
For Each cell In Range("A1:A15")
If cell.Value = "WB" Then
N = cell.Offset(0, 1).Value
End If
Next
Set AppOut = CreateObject("Outlook.Application")
Set oMailItem = AppOut.CreateItem(olMailItem)
With oMailItem
.To = K
.CC = L
.Subject = ActiveWorkbook.ActiveSheet.Name & " - " & M & " documents distribution"
.HTMLBody = "<HTML>Dear Sirs and Madams,<BODY><br><br>"
.HTMLBody = oMailItem.HTMLBody & "Please be informed that the documents delivered from " & M
.HTMLBody = oMailItem.HTMLBody & " to CPC :<br><br>"
.HTMLBody = oMailItem.HTMLBody & "for :"
.HTMLBody = oMailItem.HTMLBody & "<br><br><br><br>are available into " & N
.HTMLBody = oMailItem.HTMLBody & "<br><br><font color=red><H4>Please let us know if you notice some mistakes </font></H4>"
.HTMLBody = oMailItem.HTMLBody & "Regards,"
.Display
End With
End Sub
Mon code fonctionne parfaitement, le seul problème est un message intempestif qui apparait lorsque la macro créé le mail :
"Un programme tente d'accéder à des données Outlook, parmi lesquelles peuvent se trouver des informations du carnet d'adresse. L'autorisez vous à poursuivre ? "
J’ai trouvé pas mal de tips comme installer un soft supplémentaire (comme Clickyes)
Mais cela ne me convient pas car chaque utilisateur devrait l’installer.
De plus vu que j’ai OUTLOOK 2003 SP2, je ne peux pas simplement décocher « M’avertir lorsque qu’une source tiers essaie d’envoyer un email » dans l’onglet sécurité => ce n’est valable que pour outlook express.
Donc j’aimerais un 2ème regard sur mon code pr éviter ce message : il me semble qu’il faut pas créé un mail mais en générer un nouveau quand outlook est ouvert mais je n’y arrive pas sans avoir des erreurs « objet requis », « bloc with », etc…
Ma deuxième question concerne la signature en bas de chaque mail généré :
J’aimerais que la signature propre de chaque user puisse se mettre à la fin de chaque mail généré (peut être que la résolution de mon premier problème résoudra ce problème)
J’ai trouvé sur le forum ceci :
Public Function recuptxt(chemin As String)
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(chemin).OpenAsTextStream(1, -2)
recuptxt = ts.readall
ts.Close
End Function
.HTMLBody = oMailItem.HTMLBody & recuptxt("C:\Documents and Settings\(username)\Application Data\Microsoft\Signatures\(signature).txt")
Qui fonctionne très bien mais comment mettre le username et le nom de la signature.txt de manière dynamique car pour que ce chemin fonctionne il faut préciser le nom du user et celui de la signture mais comme cette macro sera utiliser par plusieurs personnes, ce n’est le mm nom ni signature.
Cordialement,
M&m