Envoi d'un email par Lotus Notes en Excel-VBA [Fermé]

Signaler
-
Bonjour à tous,

Au travail, on m'a demander de créer un outil pour faciliter le travail en envoyant d'un email par Lotus Notes à plusieurs destinataires. Je suis actuellement à un point sur ce project que me pose un problème.

Après de multiples recherches sur internet et sur autres forums, je n'ai pas encore trouvé de solution mais j'ai déjà une code que vous trouverez ci-dessous.

Sub SendEmailUsingCOM()


'*******************************************************************************************
' Unlike OLE automation, one can use Early Binding while using COM
' To do so, replace the generic "object" by "commented" UDT
' Set reference to: Lotus Domino Objects
'*******************************************************************************************
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String

'*******************************************************************************************
'To create notesession using COM objects, you can do so by using.
'either ProgID = Lotus.NotesSession
'or ClsID = {29131539-2EED-1069-BF5D-00DD011186B7}
'Replace ProgID by the commented string below.
'*******************************************************************************************
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}

'*******************************************************************************************
'This part initializes the session and creates a new mail document
'*******************************************************************************************
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument

'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'**********S*********************************************************************************
vToList = Application.Transpose(Range("W1").Resize(Range("W" & Rows.Count).End(xlUp).Row).Value)
vCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)

'*******************************************************************************************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'*******************************************************************************************
With nDoc

Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Validation Request")

With nAtt
.AppendText (Worksheets("Users").Range("A2").Value)

'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")

Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select

End With

Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)

End With

End Sub

J'ai essayé utiliser cette macro pour envoyer un email et ça marche avec l'onglet Paulo (par example) dans le fichier excel, mais il fait rien dans l'onglet Julia (autre onglet dans le même excel). J'ai créé une macro qui fait exactement ce que je voudrais mais le code d'erreur suivante s'affiche lorsque je cours cette macro comme on peut voir:
Run-time error '-2147217504 (80040fa0)'
Automatic error

Je crois que la ligne qui buggait était: Set nDir = nSess.GetDbDirectory("") en raison d'un double object.


Désolé pour mon mauvais français et si une a une solution, elle sera plus que bienvenue!!

En vous remerciant par avance pour votre retour,

Cdt

Miguel