Right I'm trying to send an Email form an excel spreadsheet though lotus notes, it has an attachment and the body needs to be in HTML.
I've got some code that from all I've read should allow me to do this however it doesn't.
Without the HTML body the attachment will send, when I impliment a HTML body the Email still sends but the attachment dissapears, I've tried rearanging the order of the code cutting out bits that might not be needed but all is invain.
(You need to reference Lotus Domino Objects to run this code.
strEmail is the email addresses
strAttach is the string location of the attachment
strSubject is the subject text
strBody is the body text
)
Sub Send_Lotus_Email(strEmail, strAttach, strSubject, strBody)
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object
Const EMBED_ATTACHMENT As Long = 1454
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("strAttach")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", strAttach)
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = strEmail
'.Body = strBody ' Where to send the body if HTML body isn't used.
.Subject = strSubject
.SaveMessageOnSend = True
End With
noSession.ConvertMIME = False
Set Body = noDocument.CreateMIMEEntity("Body") ' MIMEEntity to support HTML
Set stream = noSession.CreateStream
Call stream.WriteText(strBody) ' Write the body text to the stream
Call Body.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT)
noSession.ConvertMIME = True
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, strEmail
End With
'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
End Sub
If somone could point me in the right direction I'd be greatly appreciated.
Edit:
I've done a little more investigating and I've found an oddity, if i look at the sent folder the emails all have the paperclip icon of having an attachment even though when you go into the email even in the sent the HTML ones don't show an attachment.
I have managed to solve my own problem.
In teh same way you create a MIME entry and stream in the HTML you need to do the same with the attachment, you also need to put them both inside a MIME entry within the email itself to hold both the HTML and Attachment at the same level otherwise you end up with a situation of the email with the body and a child entry of the attachment which is within another attachment. (it's odd but true)
Thus this is my solution:
Sub Send_Lotus_Email(Addresses, Attach, strSubject, strBody)
'Declare Variables
Dim s As Object
Dim db As Object
Dim body As Object
Dim bodyChild As Object
Dim header As Object
Dim stream As Object
Dim host As String
Dim message As Object
' Notes variables
Set s = CreateObject("Notes.NotesSession")
Set db = s.CurrentDatabase
Set stream = s.CreateStream
' Turn off auto conversion to rtf
s.ConvertMIME = False
' Create message
Set message = db.CreateDocument
message.Form = "memo"
message.Subject = strSubject
message.SendTo = Addresses
message.SaveMessageOnSend = True
' Create the body to hold HTML and attachment
Set body = message.CreateMIMEEntity
'Child mime entity which is going to contain the HTML which we put in the stream
Set bodyChild = body.CreateChildEntity()
Call stream.WriteText(strBody)
Call bodyChild.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_NONE)
Call stream.Close
Call stream.Truncate
' This will run though an array of attachment paths and add them to the email
For i = 0 To UBound(Attach)
strAttach = Attach(i)
If Len(strAttach) > 0 And Len(Dir(strAttach)) > 0 Then
' Get the attachment file name
pos = InStrRev(strAttach, "\")
Filename = Right(strAttach, Len(strAttach) - pos)
'A new child mime entity to hold a file attachment
Set bodyChild = body.CreateChildEntity()
Set header = bodyChild.CreateHeader("Content-Type")
Call header.SetHeaderVal("multipart/mixed")
Set header = bodyChild.CreateHeader("Content-Disposition")
Call header.SetHeaderVal("attachment; filename=" & Filename)
Set header = bodyChild.CreateHeader("Content-ID")
Call header.SetHeaderVal(Filename)
Set stream = s.CreateStream()
If Not stream.Open(strAttach, "binary") Then
MsgBox "Open failed"
End If
If stream.Bytes = 0 Then
MsgBox "File has no content"
End If
Call bodyChild.SetContentFromBytes(stream, "application/msexcel", ENC_IDENTITY_BINARY)' All my attachments are excel this would need changing depensding on your attachments.
End If
Next
'Send the email
Call message.Send(False)
s.ConvertMIME = True ' Restore conversion
End Sub
Here is my actual code. I'm not even using strong type.
Dim mobjNotesSession As Object ' Back-end session reference'
Dim bConvertMime As Boolean
Dim stream As Object
Dim mimeHtmlPart As Object
Const ENC_QUOTED_PRINTABLE = 1726
mobjNotesSession = CreateObject("Lotus.NotesSession")
mobjNotesSession.Initialize()
mobjNotesDatabase = mobjNotesSession.GetDatabase("HQ2", "tim4")
mobjNotesDocument = mobjNotesDatabase.CreateDocument
bConvertMime = mobjNotesSession.ConvertMime
mobjNotesSession.ConvertMime = False
stream = mobjNotesSession.CreateStream()
Call stream.WriteText(txtBody.Text)
mobjNotesBody = mobjNotesDocument.CreateMIMEEntity("Body")
mimeHtmlPart = mobjNotesBody.CreateChildEntity() 'This returns "Type Mismatch" error'
Call mimeHtmlPart.SetContentFromText(stream, "text/html; charset=""iso-8859-1""", ENC_QUOTED_PRINTABLE)
Call stream.Close()
mobjNotesSession.ConvertMime = bConvertMime
Call mobjNotesDocument.CloseMIMEEntities(True, "Body")
No sorry I didn't i was running this in VBA which isn't strong typed so i can get away with not knowing the actual variable type for the body identity. i 've not been able to test this but I belive you need to reset the declarations to
Dim bodyChild As NotesMIMEEntity
this is the one you have trouble with the ones bellow you may find cause problems as well
Dim s As New NotesSession
Dim db As NotesDatabase
Dim body As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim stream As NotesStream
Dim host As String
Dim message As NotesDocument
Hope this helps
Related
I'm a beginner with VBA and coding in general and I'm stuck with a problem with my VBA code. Here's what I want to do :
I have two fillable fields (f_autpar_nom and f_autpar_fiche) with my Access database who need to be on my Word file at two formfield (eleves_nom and eleves_numfiche) with a command_click(). Then, my Word document opens and prompts me with a "do you want to save this" and then the Word document save as a PDF and is sent by email.
Everything is working except one thing : The formfields aren't updated when I print the PDF and return the default message I set (which is "erreur").
What I need is to find a way to update the formfield before my messagebox prompt me to send the email.
Here's the code I have with Access
Function fillwordform()
Dim appword As Word.Application
Dim doc As Word.Document
Dim Path As String
On Error Resume Next
Error.Clear
Path = "P:\Commun\SECTEUR DU TRANSPORT SCOLAIRE\Harnais\Autorisations Parentales\Autorisation parentale vierge envoyée\Autorisation_blank.docm"
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
Set doc = appword.Documents.Open(Path, , False)
With doc
.FormFields("eleves_nom").Result = Me.f_autpar_nom
.FormFields("eleves_numfiche").Result = Me.f_autpar_fiche
appword.Visible = True
appword.Activate
End With
Set doc = Nothing
Set appword = Nothing
End Function
Private Sub Commande47_Click()
Dim mydoc As String
mydoc = "P:\Commun\SECTEUR DU TRANSPORT SCOLAIRE\Harnais\Autorisations Parentales\Autorisation_blank.docm"
Call fillwordform
End Sub
and with Word
Private Sub document_open()
Dim outl As Object
Dim Mail As Object
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim PDFname As String
Msg = "L'autorisation sera sauvegardée et envoyée par email. Continuer?"
Style = vbOKCancel + vbQuestion + vbDefaultButton2
Title = "Document"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbOK Then
ActiveDocument.Save
PDFname = ActiveDocument.Path & "\" & "Autorisation Parentale " & FormFields("eleves_nom").Result & ".pdf"
ActiveDocument.SaveAs2 FileName:=PDFname, FileFormat:=wdFormatPDF
Set outl = CreateObject("Outlook.Application")
Set Mail = outl.CreateItem(0)
Mail.Subject = "Autorisation parentale " & FormFields("eleves_nom").Result & " " & FormFields("eleves_numfiche")
Mail.To = ""
Mail.Attachments.Add PDFname
Mail.Display
Application.Quit SaveChanges:=wdDoNotSaveChanges
Else
MsgBox "Le fichier ne sera pas envoyé."
Cancel = True
End If
End Sub
I didn't mean to remove the Set Doc = Nothing. My intention was to point out that whatever changes you made before that command must be lost because they weren't saved. In the code below the document is closed and saved.
Private Sub Commande47_Click()
Dim mydoc As String
mydoc = "P:\Commun\SECTEUR DU TRANSPORT SCOLAIRE\Harnais\Autorisations Parentales\Autorisation_blank.docm"
Call FillWordForm
End Sub
Function FillWordForm(Ffn As String)
Dim appWord As Word.Application
Dim Doc As Word.Document
On Error Resume Next
Set appWord = GetObject(, "word.application")
If Err.Number Then Set appWord = New Word.Application
appWord.Visible = True
On Error GoTo 0
Set Doc = appWord.Documents.Open(Ffn, , False)
' the newly opened document is activated by default
With Doc
.FormFields("eleves_nom").Result = Me.f_autpar_nom
.FormFields("eleves_numfiche").Result = Me.f_autpar_fiche
.Close True ' close the file and save the changes made
End With
Set appWord = Nothing
End Function
However, I also agree with #Kazimierz Jawor that your construct is unfortunate. Basically, the document's On_Open procedure should run when you open the document from Access. Therefore the email is probably sent before you even get to setting the form fields. My suggestion to save the changes is likely to take effect only when you run the code the second time.
The better way should be to send the mail from either Access or Word. My preference would be the latter. It should be easy to extract two values from an Access table using Word, add them to a Word document and mail out the whole thing. I don't see, however, why you should use the Open event to do that. If that choice is the more logical one then doing everything from within Access would be the conclusion.
I am using lotus notes form as .html files and I am sending values to server as json using angular js. But I want to upload files also now. How can I send files to server and extract using lotus script?
Can you please help me someone?
Like the below post. But it is done in ASP.NET . I want to do the same using lotus notes.
File uploading angular js ASP .NET
index.html
<span ng-if="quests.type == '17'">
<input type="file" file-upload multiple id='{{quests.id}}'/>
</span>
<button type="button" ng-click="submitForm();">Submit</button>
The above button will trigger the below code to executed.
Angular Code to post to server
var email=document.getElementById("email").value;
var message={"requesttype": "saveForm","email": emailid,"username": username};
$http.post("http://test.com/ajaxprocess?openagent", message).success(success).error(failure);
The above mentioned agent(lotusscript) will parse the above json and save the document as shown below.
ajaxprocess Agent code
'getting document context
Set docContext = sess.DocumentContext
If docContext.hasItem("REQUEST_CONTENT") Or docContext.hasItem("REQUEST_CONTENT_000") Then
'using openNTF lotus script classes to parse document to json object
Set userDataInfo=getJSONObjectFromDocument(docContext, "")
Dim fieldsobj As New JSONArray
'getting the fields array sent as json array
Set fieldsobj=userDataInfo.GetItemValue("fields")
fieldtype=Field.mGetItemValue("type")(0)
Dim doc As NotesDocument
Dim fieldname As String
ForAll Field In fieldsobj.Items
fieldname=Field.mGetItemValue("Fieldname")(0)
Call doc.Replaceitemvalue(fieldname,Field.mGetItemValue("value")(0))
End ForAll
call doc.save(true,false)
End If
Everything works fine expect file attachments. How can I send files to server with json and save using lotus script or is there any other workaround is there?
I finally found tip and made the solution as follows to get the base64 String and convert to attachment in lotusscript.
http://www-10.lotus.com/ldd/bpmpblog.nsf/dx/creating-a-mime-email-with-attachment?opendocument&comments
Dim s As New NotesSession
Dim stream As NotesStream
Dim body As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim StringInBase64 As String
StringInBase64=getbase64() 'your base64 string
Dim db As NotesDatabase
Set db=s.Currentdatabase
Dim tempdoc As NotesDocument
Set tempdoc=db.Createdocument()
Set stream = s.CreateStream
Call stream.WriteText(StringInBase64)
Set body = tempdoc.CreateMIMEEntity
Set header = body.createHeader("content-disposition")
Call header.setHeaderVal({attachment;filename="Onchange.xlsx"}) ' file name and type should be configurable
Call body.SetContentFromText(stream, "", ENC_BASE64)
Call stream.Close
tempdoc.form="Attachment"
Call tempdoc.save(True,False)
This works as expected. Thanks all for time you spent.
Here is the code for Multiple attachments, enhancement from Vijayakumar.
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Set db = session.CurrentDatabase
Set doc = db.CreateDocument
Dim s As New NotesSession
Dim stream As NotesStream
Dim body As NotesMIMEEntity
Dim child As NotesMimeEntity
Dim header As NotesMIMEHeader
Set body = doc.CreateMIMEEntity
topString = Split(BASE64, ",")
Dim tmp_array() As String
i = 0
For i = 0 To Ubound(topString)
Redim Preserve tmp_array(i)
tmp_array(i) = topString(i)
Set child = body.CreateChildEntity()
Set header = child.CreateHeader("Content-Type")
Call header.SetHeaderVal("multipart/mixed")
Set header =child.createHeader("Content-Disposition")
Call header.setHeaderVal({attachment; filename=test} &Cstr(i)& {.jpg}) 'file name and type should be configure
Set header =child.CreateHeader("Content-ID")
Call header.SetHeaderVal("test" &Cstr(i)& ".jpg")
Set stream = s.CreateStream()
Call stream.WriteText(topString(i))
Call child.SetContentFromText(stream, "", ENC_BASE64)
Next
doc.form="Attachment"
'doc.Attachment = tmp_array
Call doc.save(True,False)
Call stream.Close()
s.ConvertMIME = True ' Restore conversion
I am currently using the code below to send out mails from access with an attachment. But i searched everywhere with no luck for a sokution to get the attachment embeded into the mail body itself. Anyone can help me out.
Option Compare Database
Option Explicit
'Declare public object variables
Public mkfDoc As String
Public Subject, Attachment, Recipient, copyto, BodyText, UserName, SaveIt
Public Maildb As Object 'The mail database
Public MailDbName As String 'The current users notes mail database name
Public MailDoc As Object 'The mail document itself
Public AttachME As Object 'The attachment richtextfile object
Public Session As Object 'The notes session
Public EmbedObj As Object 'The embedded object (Attachment)
Public Function sendNotes(ByVal strTo As String, ByVal Attachment As String, ByVal strSubject As String, ByVal strBody As String)
'Set up the objects required for Automation into lotus notes
Subject = strSubject
'Attachment = "c:\foldername\filename.extension"
Recipient = Split(strTo, ",")
'Set bodytext for mail offer - language depends on field in offprofrm
BodyText = strBody
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", MailDbName)
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 = Recipient
MailDoc.Subject = Subject
MailDoc.Body = BodyText
MailDoc.SAVEMESSAGEONSEND = True
'Set up the embedded object and attachment and attach it
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
MailDoc.CREATERICHTEXTITEM ("Attachment")
End If
'Send the document + notify
MailDoc.PostedDate = NOW() 'Gets the mail to appear in the sent items folder
MailDoc.SEND 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Function
A good way to create an email with included attachments in body field is to use the MIME format.
Set body = MailDoc.CreateMIMEEntity("Body")
...
Have a look at http://www-10.lotus.com/ldd/bpmpblog.nsf/dx/creating-a-mime-email-with-attachment and https://stackoverflow.com/a/2514633/2065611 how to do it.
As far as I know, you can only embed images in a rich text field using the Import method of the NotesUIDocument class, unless you want a much more complicated way.
The two ways I could see this being possible:
* Use Midas LSX from GeniiSoft (commercial product)
* Export the document as DXL, add the image (encoded as Base64) and then import the DXL back as a Notes document.
First you need to create an outlook mail object, then, write the mail body (in html) with the appropriate <img src='myfile.jpg'> tag. Please note following points :
- embedded images must be save on your computer (as a jpg file or png file) ;
- Since outlook 2013, embedded images must be attached to the email as well.
At the link below you will find all details and a working code template
http://vba-useful.blogspot.fr/2014/01/send-html-email-with-embedded-images.html
I've wrote a script to create a HTML file based on a SQL Query.... It has become necessary to have that HTML be emailed. Most of our execs use blackberry's and I want to send the HTML file as the body. I have found a round about way to get this done, by adding a WebBrowser, and having the web browser then load the file, and then using the below code to send. The problem i'm facing is if I automate the code fully, it will only email part of the HTML document, now if I add a button, and make it do the email function, it sends correctly. I have added a wait function in several different location, thinking it may be an issue with the HTML not being fully created before emailing. I have to get this 100% automated. Is there a way I can use the .HTMLBody to link to the actual HTML file stored on the C:(actual path is C:\Turnover.html). Thanks all for any help.
Public Sub Email()
Dim strdate
Dim iCfg As Object
Dim iMsg As Object
strdate = Date.Today.TimeOfDay
iCfg = CreateObject("CDO.Configuration")
iMsg = CreateObject("CDO.Message")
With iCfg.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxx.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = """Turnover Report"" <TurnoverReports#xxxxx.com>"
.Update()
End With
With iMsg
.Configuration = iCfg
.Subject = "Turnover Report"
.To = "xxxxx#xxxxx.com"
'.Cc = ""
.HTMLBody = WebBrowserReportView.DocumentText
.Send()
End With
iMsg = Nothing
iCfg = Nothing
End Sub
used the below function to read in a local html file. then set
TextBox2.Text = getHTML("C:\Turnover2.html")
and also
.HTMLBody = TextBox2.Text
Private Function getHTML(ByVal address As String) As String
Dim rt As String = ""
Dim wRequest As WebRequest
Dim wResponse As WebResponse
Dim SR As StreamReader
wrequest = WebRequest.Create(address)
wResponse = wrequest.GetResponse
SR = New StreamReader(wResponse.GetResponseStream)
rt = SR.ReadToEnd
SR.Close()
Return rt
End Function
Can anyone spot an obvious reason as to why my save function isn't saving the fields in my form? It saves the document, but the fields are empty when I open it up. The following code is what I'm using:
Public Sub co_loopNamesAndSaveDocs()
'Dim variables
Dim s As New NotesSession
Dim thisDatabase As NotesDatabase
Set thisDatabase = s.CurrentDatabase
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = ws.CurrentDocument
Dim currentDoc As NotesDocument
Set currentDoc = uidoc.Document
Dim newDoc As NotesDocument
Dim PersonNameField As NotesItem
Set PersonNameField = currentDoc.GetFirstItem("PersonName")
'Loop through values in PersonNameField and create a new document for each value found
Forall pName In PersonNameField.Values
Set newDoc = New NotesDocument (thisDatabase)
newDoc.Form="newLocationForm"
newDoc.StartDate = currentDoc.StartDate(0)
newDoc.EndDate = currentDoc.EndDate(0)
newDoc.Duration = currentDoc.Duration(0)
newDoc.StartTime = currentDoc.StartTime(0)
newDoc.EndTime = currentDoc.EndTime(0)
newDoc.Comments = currentDoc.Comments(0)
newDoc.Status = currentDoc.Status(0)
newDoc.LocationCode = currentDoc.LocationCode(0)
newDoc.PersonName = pName
Call newDoc.Save (True, False, False)
End Forall
End Sub
Thanks in advance.
Since I don't see an obvious error in the coding, I'd say that the fields in newDoc are blank because the fields in currentDoc are blank. And since currentDoc was set to uidoc.Document, that probably means that you have a synch problem between front-end and back-end documents. I.e., the values exist in your uidoc, but have not yet been saved to the back-end prior to calling this code. If I'm right, try calling uidoc.save() before assigning currentDoc. If you don't want to save to the back-end, then instead of using the back-end as your data source you should be using uidoc.fieldGetText("PersonName") and parsing out the values.