Code VB - Envoie mail Lotus

[limofab]

Bonjour à tous,

J'ai une feuille Excel avec un bouton "Mail" qui permet en cliquant dessus d'envoyer cette feuille par courriel. Je suis actuellement sous la version 5 de lotus.
Sur certain ordinateur, je suis passé en version 7. Avec cette version, impossible d'envoyer le mail ! Je pense que la bibliothèque Lotus 7 n'est pas connu sous Excel 97.

Est ce que quelqu'un a une astuce pour pouvoir utiliser ce code avec Lotus 5 et 7

Merci d'avance !

Voici le code VB actuel :

Private Sub mail_Click()

adrguichet = "mail@mail.fr"
DBcourrier = adrguichet


Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim Devis As String
Set session = CreateObject("Notes.NotesSession")

Sheets("Devis").Select 'sélectionne la feuille
Nom_Fic = Range("b5").FormulaR1C1 'Récupère le nom du fichier

If Nom_Fic = "" Or IsNull(Nom_Fic) Then
MsgBox "Veuillez entrer un nom de client", vbOKOnly, "Attention"
Exit Sub
End If

Nom_Fic = Application.ActiveWorkbook.Path & "\" & Nom_Fic & ".xls"

Set Maildb = session.GetDatabase("", "")

If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OpenMail
End If
'Set up the new mail document
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"

MailDoc.sendto = adrguichet

'Récupère l'objet du message
'Sheets("messagerie").Select

MailDoc.Subject = "dossier " & Nom_Fic & "à traiter"
MailDoc.body = "Bla bla dans le mail"

MailDoc.SaveMessageOnSend = True
'MailDoc.SaveMessageOnSend = SaveIt
'Set up the embedded object and attachment and attach it


Set AttachME = MailDoc.CreateRichTextItem("Attachment_doc")
Set EmbedObj = AttachME.EmbedObject(1454, "", Nom_Fic, "Attachment_doc") 'Pièce jointe ici
MailDoc.CreateRichTextItem ("Attachment_doc")


'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder 'on peut dater le message
MailDoc.Send 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj = Nothing
MsgBox "Fichier et message envoyés vers " & adrguichet, vbOKOnly

Dim Wb As Workbook

For Each Wb In Application.Workbooks
Wb.Saved = True
Next Wb

Application.Quit
End Sub

 

[BERRACHED said]

Re : Code VB - Envoie mail Lotus

Salut,limofab

Essaye ce code :

Sub Envoi()
    Dim Sujet As String, Corps As String, Desti As String
    Dim CC As String, c As Range, PJ As String
    Sujet = "Sujet du message"
    Corps = "Corps du message"
    CC = ""
    Desti = "****@*****.***"
    PJ = "c:\temps\PieceJointe.xls"
    SendNotesMail Sujet, Corps, Desti, CC, PJ
End Sub

Public Sub SendNotesMail(Sujet, Corps, Desti, CC, PJ)
'Mettre en place les objets nécessaires à l'automatisation dans Lotus Notes
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim Corps_Msg As String ' text du courriel
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    'Démarrer une session de notes
    Set Session = CreateObject("Notes.NotesSession")
    'Suivant la ligne ne fonctionne qu'avec les 5.x et plus. Remplacer le mot de passe avec votre mot de passe
     Session.Initialize (" password ")
     'Obtenir le nom d'utilisateur et sessions puis calculer le nom de fichier électronique
     'Vous mai mai ou pas besoin de ce que pour MailDBname avec certains systèmes, vous
     'peut passer une chaîne vide ou en utilisant le mot de passe ci-dessus vous pouvez utiliser d'autres boîtes aux lettres.
 
  MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) & InStr(1, UserName, " "))) & ".nsf"

     UserName = Session.UserName

     SearchString = Recipient
     SearchChar = "@"
     MyPos = InStr(1, SearchString, SearchChar, vbTextCompare)
     Destinataire = Left(SearchString, MyPos - 1)
    'Ouvrez la base de données électronique dans les notes
    Set Maildb = Session.GETDATABASE("", "")
     If Maildb.IsOpen = True Then
         'Déjà ouvert pour le courrier
     Else
         Maildb.OPENMAIL
     End If
    'Mettre en place le nouveau document électronique
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.sendto = Desti
    MailDoc.Subject = Sujet
    MailDoc.copyto = CC
    MailDoc.Body = Corps
    Set MailCorps = MailDoc.CREATERICHTEXTITEM("Body")

    With MailCorps
    .ADDNEWLINE 1
    .AppendText Corps
    .ADDNEWLINE 2
    End With

    MailDoc.SAVEMESSAGEONSEND = True
    'Mettre en place l'objet incorporé et de l'attachement et la joindre
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
    AttachME.AppendText "toto"
    Call AttachME.EMBEDOBJECT(1454, "", PJ, "Attachment")
    'Envoyer le document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.Send 0
    'Clean vers le haut
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

Cordialement

 

[limofab]

Re : Code VB - Envoie mail Lotus

OK merci, je vais essayer ça lundi, je te tiens au courant.

Merci