XL 2013 ficher excel fermé par lotus notes

Arctica

XLDnaute Nouveau
bonjour,

je voudrais envoyer un fichier Excel fermé par email en utilisant lotus notes 8.5 je réussis bien a envoyer le texte mais pas le fichier, j'avais une macro qui fonctionnait bien avec Outlook mais là les écrits n'étant pas les mêmes je suis perdu, pouvez vous m'aider car je ne sais pas si le chemin indiqué est placé au bon endroit ?
voici le code

Public Sub RoutineEnvoiMailLotus()
Application.ScreenUpdating = False
'------- compléter les variables nécessaires pour envoi --------------
AdresDestinataire$ = "philippe.lohr@fr.rhenus.com" 'si plusieurs adresses séparer par le point virgule !
Sujet$ = "interimaires" ' sujet
Message$ = "Bonjour, " & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
"Veuillez trouver en pièce jointe le fichier de nos interimaires " & " " & MaDate & ":" & _
vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Salutations" ' message
Fichier$ = "Dachser.xlsx" ' "NomDuFichier.xlsx"
Chemin$ = "C:\Users\philippe.lohr\Desktop\Dachser.xlsx" ' chemin du fichier exp: = ThisWorkbook.Path
If Chemin$ > "" And Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\"
CheminEtFichier$ = Chemin$ & Fichier$

'------ départ envoi messagerie --------
'met en tableau si plusieurs adresses !?
If InStr(AdresDestinataire$, ";") = 0 Then AdresDestinataire$ = AdresDestinataire$ & ";"
Dim TabloAdresDestin As Variant
TabloAdresDestin = Split(AdresDestinataire$, ";")

'------ préparation session ------
On Error GoTo ErreurNET: Err.Clear

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

' Création de la session
Set oSession = CreateObject("Notes.NotesSession")
' Récupèration du 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

' boucle envoi au(x) destinataire(s)
For i = LBound(TabloAdresDestin) To UBound(TabloAdresDestin)
If Trim(TabloAdresDestin(i)) > "" Then
AdresDestinataire$ = TabloAdresDestin(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 a !?
If CheminEtFichier$ <> "" Then
Set AttachME = Document.CreateRichTextItem("Attachment")
Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
End If
'Envoi le Mail
Document.SaveMessageOnSend = True 'True = save dans les courriers envoyés
Document.PostedDate = Now() ' date du jour
Document.Send 0, AdresDestinataire$ 'envoi
'reinit adresse suivante !?
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:
'libère les variables Object
Set oSession = Nothing: Set DataBase = Nothing
Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
End Sub
ci le code
 

Discussions similaires

Réponses
6
Affichages
305

Statistiques des forums

Discussions
312 215
Messages
2 086 328
Membres
103 180
dernier inscrit
Vcr