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.