Macro Sendmail avec iNotes, possible ou impossible?

Bonjour le forum

Je suis à la recherche du set de iNotes (la version web de Lotus Notes). C'est pour une macro Excel.

J'ai un fichier Excel type formulaire contenant un bouton envoi automatique par courrier qui fonctionne très bien avec Lotus Notes. Mais, j'ai des utilisateurs du formulaire qui ont seulement la version web de Lotus Notes (iNotes).

Peut-être est-il possible (ou impossible) d’ajuster la macro à iNotes! Chose certaine, s'il existe, je ne le trouve nulle part!

Celui de Lotus Notes se décline ainsi:

SET SESSION = CREATEOBJECT("NOTES.NOTESSESSION")

SET MAILDB = SESSION.GETDATABASE("", "")

Quelqu’un aurait ce précieux renseignement ou saurait comment le trouver?

Merci.

Bonjour

il semblerait que la solution passe par la méthode CDO, mais là les amis, si je trouve que je suis nul en VBA, imaginez avec une méthode pour développeurs!

Quelqu'un s'aurait adapter mon code avec la méthode CDO?

Voici le code:

Sub SendMail()
    Dim Maildb As Object 'The mail database
    Dim session As Object 'The notes session
    Dim MailDoc As Object 'The mail document itself
    Dim attachME As Object
    Dim EmbedObj As Object
    Dim Recipient As String
    Dim Subject As String
    Dim lefichier As String
    Dim filepath As String
    Dim WasOpen As Integer
    Dim NouveauWorkbook As String
    Dim WorkbookActuel As String
    Dim nomsanscarspec As String
    Dim A As String
    Dim B As String
    Dim i As Integer
    Dim dd As DropDown
    Dim objetdemande As String
    Dim extension As String

    For Each dd In ActiveSheet.DropDowns
        objetdemande = dd.List(dd.ListIndex)
    Next

    If Range("F5") = "" Then
        MsgBox ("Veuillez remplir la SECTION « profil informatique équivalent » avant d'envoyer votre demande.")
        Exit Sub
    End If
    If Range("B8") = "" Then
        MsgBox ("Vous devez inscrire le numéro de VM du poste de travail avant d'envoyer votre demande.")
        Exit Sub
    End If

    Set session = CreateObject("Notes.NOTESSESSION")
    Set Maildb = session.GETDATABASE("", "")
    On Error GoTo ErrorHandler
        Maildb.OPENMAIL
    On Error GoTo 0

    Rows("1:22").Select
    Application.CutCopyMode = False
    Selection.Copy

    WorkbookActuel = ActiveWorkbook.Name
    Workbooks.Add
    NouveauWorkbook = ActiveWorkbook.Name

    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveWindow.Zoom = 100
    Application.CutCopyMode = False
    With ActiveWorkbook
        .PrecisionAsDisplayed = False
        .Date1904 = True
    End With
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    Set objfolders = CreateObject("WScript.Shell").SpecialFolders
    filepath = objfolders("mydocuments")
    If Right(filepath, 1) = "\" Then filepath = filepath & "demande_d'accès_informatique\" Else filepath = filepath & "\demande_d'accès_informatique\"

    For i = 1 To Len(Range("B7").Value)
        B = Mid(Range("B7").Value, i, 1)
        If B Like "[A-Za-z]" Then
            A = A & B
        End If
    Next i

    For Each dd In ActiveSheet.DropDowns
        dd.Visible = False
    Next

    Range("A1").Value = "Formulaire - Demande d'accès"
    Range("A1:I22").Select
    Application.CutCopyMode = False
    Selection.Locked = False
    Selection.FormulaHidden = False
    Rows("22:" & Rows.Count).Select
    Selection.EntireRow.Hidden = True
    ActiveSheet.Protect Password:="mlai", Contents:=True, AllowFormattingCells:=True

    If Val(Application.Version) < 12 Then
        extension = ".xls"
    Else
        extension = ".xlsx"
    End If

    ActiveWorkbook.SaveAs (filepath & A & "_" & Range("B5").Value & "_" & Range("C5").Value & "_" & Format(Now, "yymmdd") & extension)

'    If MsgBox("Voulez-vous imprimer une copie de la demande pour vos dossiers?", vbYesNo) = vbYes Then ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

    lefichier = ActiveWorkbook.FullName
    lefichiernom = Split(lefichier, "\")(UBound(Split(lefichier, "\")))

    ActiveWorkbook.Close

    Recipient = Sheets("Formulaire").Range("A25").Value
    Subject = "Accès informatique " & " - " & Range("B05").Value & " - " & Range("C05").Value

    MsgBox ("Envoie du courriel par " & Maildb.Title & " sur le serveur " & Maildb.SERVER)

    Set MailDoc = Maildb.CreateDocument
    Set attachME = MailDoc.CreateRichTextItem("Attachment")
    Set EmbedObj = attachME.EmbedObject(1454, "", lefichier, "Attachment")
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.Subject = Subject
    MailDoc.body = "Bonjour, pour traitement, svp. Merci!"
    MailDoc.ReturnReceipt = "1"
    MailDoc.SaveMessageOnSend = True
    'MailDoc.PostedDate = Now()
    MailDoc.SEND 0, Recipient

    SaveSetting "Mes parametres", "NomDemandeur", "NomDemandeur", Range("B10").Value
    SaveSetting "Mes parametres", "TelDemandeur", "TelDemandeur", Range("B09").Value

    MessageCourriel.Label1.Caption = "- Votre demande a été envoyée par courriel à l'adresse: " & Recipient
    MessageCourriel.Label3.Caption = "- Une copie du formulaire a été enregistrée dans vos documents à l'emplacement: " & filepath & vbLf & "Le nom du fichier est:" & vbLf & lefichiernom
    MessageCourriel.Show

    'CalendrierOK = True
    CommOK = True
    CatOK = True
    'HrsMinsOK = True

    Range("A2").Value = ""
    Range("B05:C10").Value = ""
    Range("F5:G6").Value = ""
    Range("E8:I10").Value = ""
    Range("A13:I22").Value = ""
    For Each dd In ActiveSheet.DropDowns
        dd.ListIndex = 1
    Next

    'CalendrierOK = False
    CommOK = False
    CatOK = False
    'HrsMinsOK = False

    Set session = Nothing
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set attachME = Nothing
    Set EmbedObj = Nothing
Exit Sub
ErrorHandler:
    MsgBox ("Vous devez être connecté dans votre session Lotus Notes pour utilisé cette fonctionnalité, une fois connecté à Lotus Notes appuyez sur OK et votre demande sera envoyée")
    Set Maildb = session.GETDATABASE("", "")
    Resume
End Sub

merci encore mille fois pour votre intérêt de ce qu'il me semble un méchant défi.