macro envoi corps de texte dans mail (lotus)

[olivemotard]

Bonjour a Tous.

Je reviens a nouveau vers vous les XLDnautes...

J'ai fait une macro qui va chercher des adresses mails, les place en bcc, inscrit le sujet, et un message.

Le probleme c'est ce message, je souhaiterai faire apparaitre une plage de cellules et je n'y arrive pas...
Il faut que je remplace "message" par une commande qui va chercher sheets("consultation").Range("A1:I53") (j'arrive a le copier en auto mais pas a le coller dans lotus (en gardant la mise en forme tableau si possible.

Voici ma macro

Private Sub CommandButton4_Click()

    Sheets("Feuil1").Select
    Sheets("Feuil1").Copy
    ActiveWorkbook.UpdateLinks = xlUpdateLinksNever
    ActiveWorkbook.SaveAs Filename:=[B1].Value & [B2].Value & [B3].Value & ".xls"
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close
    
Dim obj As String
Dim strbody As String
Dim myStr As String
Dim myStr1 As String
obj = "consultation"
strbody = [COLOR="Red"]"message"[/COLOR]

 
For I = 1 To 100
If InStr("@", Trim(Cells(I, 26))) = 0 Then
myStr = Cells(I, 26)
If InStr("@", Trim(Cells(I, 27))) = 0 Then
myStr1 = Cells(I, 27) & Cells(I, 28) & Cells(I, 29) & Cells(I, 30) & Cells(I, 31) & Cells(I, 32) & Cells(I, 33) & Cells(I, 34) & Cells(I, 35) & Cells(I, 36) & Cells(I, 37) & Cells(I, 38) & Cells(I, 39) & Cells(I, 40) & Cells(I, 41) & Cells(I, 42) & Cells(I, 43) & Cells(I, 44)
End If
myStr = Left(myStr, Len(myStr))
myStr1 = Left(myStr1, Len(myStr1))
copie = myStr1
URLto = "mailto:" & Adresse & "?subject=" & obj & "&body=" & strbody & "&Bcc=" & copie
ActiveWorkbook.FollowHyperlink Address:=URLto
myStr = ""
myStr1 = ""
End If
Next

Unload UserForm5
Unload UserForm4
Unload UserForm3
Unload UserForm2
Unload UserForm1

UserForm6.Show

End Sub

Le debut de mon code est la sauvegarde dans un fichier annexe d'un tableau comparatif.

Merci d'avance, je suis vraiement bloqué, cela fait trois jours que je retourne le problème dans tous les sens et je suis au bout de mes compétences (trés limitées).

 

[degap05]

Re : macro envoi corps de texte dans mail (lotus)

Bonjour,

Peut-être une aide de ce côté là:

Ron's Excel Tips

Pour ma part j'utilise une des fonctions proposées, avec Outlook: Range In Body

A+

 

[olivemotard]

Re : macro envoi corps de texte dans mail (lotus)

Merci Degap05

Mais dans ce code, je ne trouve pas mon bonheur, j'ai éssayé de prendre des petits bouts, meme la macro entierre pour voir si c'était pas mieux, mais rien ne marche...

Je ne comprends rien, j'arrive a mettre un petit texte mais pas une plage de cellule et je ne comprend vraiement pas pourquoi ?

Merci quand même de t'être intéressé a mon soucis.Bonne journée

 

[Roland_M]

Re : macro envoi corps de texte dans mail (lotus)

bonsoir,

si cela peut t'aider, ci-joint une routine que j'utilise dans mon entreprise
avec quelques remarques:
(l'idéal pour envoyer des données est de créer un classeur pour mettre en pièce jointe
tu copies ton champ de données dans une feuille d'un nouveau classeur que tu sauvegardes
et que tu effaces par après)

' --------- Envoi d'un mail avec Lotus Notes ---------- .
'Ajouter la référence Lotus Domino Objects (domobj.tlb) .
'Cocher Référence  [x]Lotus Domino Objects              .
'entrée du CheminEtFichier s'il y a lieu
'entrée Sujet et Message As String
Public Sub EnvoiMailLocal(CheminEtFichier As String, Sujet As String, Message As String)
Dim oSession As Object     'CreateObject("Notes.NotesSession")
Dim UserName As String     'Nom d'utilisateur
Dim DataBase As Object     'Base des mails
Dim DataBaseName As String 'Nom de la base
Dim Document As Object     'Mail
Dim AttachME As Object     'Fich joint en RTF
Dim AttachF1 As Object     '1' pièce attachée

On Error GoTo ErreurNET: Err.Clear '*****

' Crée la session
Set oSession = CreateObject("Notes.NotesSession")
' Récupère nom d'utilisateur
UserName = oSession.UserName
DataBaseName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
' Ouvre la base des mails (si fermé, ouvre et demande le password)
Set DataBase = oSession.GetDataBase("", DataBaseName)
If Not DataBase.IsOpen Then DataBase.OpenMail

'########################## envoi ###############################################
'récupère dans la feuille nommée NomDeLaFeuilDATA$ et le Range nommé "CellDATA_AdresDestinataire"
'les adresses séparées par ";"
Dim Tablo As Variant, AdresDestinataire As String
AdresDestinataire = Sheets(NomDeLaFeuilDATA$).Range("CellDATA_AdresDestinataire")
If InStr(AdresDestinataire, ";") = 0 Then AdresDestinataire = AdresDestinataire & ";"
Tablo = Split(AdresDestinataire, ";")
'       boucle envoi                 .
For I = LBound(Tablo) To UBound(Tablo)
 If Trim(Tablo(I)) > "" Then
    AdresDestinataire = Tablo(I)
    'crée le document et colle /AdresDestinataire /Sujet /Message
    Set Document = DataBase.CreateDocument
    Document.Form = "Memo"
    Document.Sendto = AdresDestinataire
    Document.Subject = Sujet
    Document.Body = Message
    'Joint le Fichier s'il y en a un !?
    If CheminEtFichier <> "" Then
       Set AttachME = Document.CreateRichTextItem("Attachment")
       Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
    End If
    'Envoi le Mail
    Document.SaveMessageOnSend = True 'True svg dans les courriers envoyés
    Document.PostedDate = Now()
    Document.Send 0, AdresDestinataire
    ' suite...
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
 End If
Next
GoTo FinMail ' fin ##############################################################

ErreurNET:
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
GoTo FinMail

FinMail:
Set oSession = Nothing: Set DataBase = Nothing
Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
On Error GoTo 0: Err.Clear
End Sub

 

[olivemotard]

Re : macro envoi corps de texte dans mail (lotus)

Merci Roland.

J'ai amélioré ma macro avec des morceaux de la tienne.
Encore Merci