[Solved] Send email with Subject & Body text

Discuss the database features

[Solved] Send email with Subject & Body text

Postby splashboard » Mon Feb 03, 2014 6:38 pm

I'm using OpenOffice 4.1.0 and Basic macro code with a Windows 7 PC.

I'm developing a club members database from which I wish to send email messages to members which need to have a Subject & Body text, so I believe that I cannot use the Simple mail functions.

I have found and adapted the code from RPG's thread ('How to get parameters of objects, services', posted on 4th Feb 2013; sorry I don't know how to create a hyperlink to this).

When I execute this code step-by-step it fails as it attempts to do the 'service.connect(server, mailuser)' line. This calls the function 'smtp_getvaluebyname(what)' with arguments 'Servername', 'Port' & 'Timeout'. It fails after setting the 'Timeout' parameter with a BASIC run-time error, the last line of which reads:
C\Program Files (x86)\OpenOffice 4\program\mailmerge.py:114 in function connect() [self.server = smtplib.SMTP(server, port, timeout=tout)]
email_error_port-465-timeout-5.png

Can anyone advise me what is wrong with my code and how to fix it?

My code is: -


Code: Select all   Expand viewCollapse view
'   ************************************************************************************************
'   email routines
'   ======= extract attachment data from file ========
'   ------------------------------------------------------------------------------------------------
sub Testmail
   smtpPassword = inputBox("Password", "Password:", "")
   attachmentType = "application/pdf"
'   sendMail(testRecipient, "Attachment", "Test the first", _
'      ConvertToUrl("c:\Documents and Settings\James\Desktop\test.pdf"))
   sendMail(testRecipient, "Test email", "Test email body text")
end sub

' ======== your details go here ========
   global const myAddress = "jeff.asplin@gmail.com"
   global const smtpServer = "smtp.gmail.com"
   global const smtpPort = 465
   global const smtpTimeout = 20
   global const smtpSecure = true
   global const smtpUser = "jeff.asplin@gmail.com"
   global const testRecipient = "jeff.asplin@ntlworld.com"

   global const attachmentMaxSize = 100000

' these variables are needed by listener functions, to which they cannot be passed as arguments
   global smtpPassword as String
   global messageBody as String
   global attachmentContents as Object
   global attachmentType as String

sub sendMail(recipient, subject, body, Optional attachmentUrl)
   dim bodyObject as Object, attachment as Object, message as Object, _
   serviceProvider as Object, service as Object, server as Object, mailUser as Object
   bodyObject = CreateUNOListener("body_", "com.sun.star.datatransfer.XTransferable")
   messageBody = body

   if not IsMissing(attachmentUrl) then
      if attachmentFromUrl(attachment, attachmentUrl) <> "OK" then
         exit sub
      end if
   end if

   message = com.sun.star.mail.MailMessage.createWithAttachment(recipient, myAddress, subject, bodyObject, attachment)
   serviceProvider = CreateUNOService("com.sun.star.mail.MailServiceProvider")
   service = serviceProvider.Create("com.sun.star.mail.SMTP")
   server = CreateUNOListener("smtp_", "com.sun.star.uno.XCurrentContext")
   mailUser = CreateUNOListener("user_", "com.sun.star.mail.XAuthenticator")

   service.Connect(server, mailUser)
   service.SendMailMessage(message)
   service.Disconnect()

end sub

'   --------------------------------------------------------------------------------------------------------

function attachmentFromUrl(attachment, url)
   dim chunks() as String, fileName as String, fileService as Object, _
   attachmentFile as Object, fileContents() as Byte

   chunks() = Split(url, "/")
   fileName = ConvertFromUrl(chunks(UBound(chunks()))

   fileService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
   attachmentFile = fileService.OpenFileRead(url)
   attachmentFile.ReadBytes(fileContents(), attachmentMaxSize + 1)
   attachmentFile.CloseInput

   if (UBound(fileContents()) + 1 > attachmentMaxSize) then
      msgBox "Attachment file '" & fileName & "' is too big"
      exit function
   elseIf (UBound(fileContents()) < 0) then
      msgBox "Attachment file '" & fileName & "' is empty"
      exit function
   end if

     attachmentContents = CreateUnoValue( "[]byte", fileContents())
   attachment = CreateObject("com.sun.star.mail.MailAttachment")
   attachment.Data = CreateUNOListener("attachment_", "com.sun.star.datatransfer.XTransferable")
   attachment.ReadableName = fileName

   attachmentFromUrl = "OK"
end function

' ===== server properties =====

'   ------------------------------------------------------------------------------------------------

function smtp_GetValueByName(what)
   select case what
      case "ServerName"
         smtp_GetValueByName = smtpServer
      case "Port"
         smtp_GetValueByName = smtpPort
      case "Timeout"
         smtp_GetValueByName = smtpTimeout
      case "ConnectionType"
         if smtpSecure then
            smtp_GetValueByName = "SSL"
         else
            smtp_GetValueByName = "Insecure"
         endif
   end select
end function

' ====== email user methods =======

'   ------------------------------------------------------------------------------------------------

function user_GetUserName()
   user_GetUserName = smtpUser
end function

'   ------------------------------------------------------------------------------------------------

function user_GetPassword()
   user_GetPassword = smtpPassword
end function

' ====== message body object methods ======

'   ------------------------------------------------------------------------------------------------

function body_GetTransferDataFlavors()
   dim flavor as new com.sun.star.datatransfer.DataFlavor
   flavor.MimeType = "text/plain;charset=utf-16"
   flavor.HumanPresentableName = "Unicode text"
   body_getTransferDataFlavors = Array(flavor)
end function

'   ------------------------------------------------------------------------------------------------

function body_GetTransferData(flavor) as any
   if (flavor.MimeType = "text/plain;charset=utf-16") then
      body_GetTransferData = messageBody
   end if
end function

'   ------------------------------------------------------------------------------------------------

function body_isDataFlavorSupported(x as Object)
   body_isDataFlavorSupported = (x.MimeType = "text/plain;charset=utf-16")
end function

' ====== attachment object methods ======

'   ------------------------------------------------------------------------------------------------

function attachment_GetTransferDataFlavors()
   dim flavor as new com.sun.star.datatransfer.DataFlavor
   flavor.MimeType = attachmentType
   flavor.HumanPresentableName = attachmentType
   attachment_getTransferDataFlavors = Array(flavor)
end function

'   ------------------------------------------------------------------------------------------------

function attachment_GetTransferData(flavor) as any
   if (flavor.MimeType = attachmentType) then
      attachment_GetTransferData = attachmentContents
   end if
end function

'   ------------------------------------------------------------------------------------------------

function attachment_isDataFlavorSupported(x as Object)
   attachment_isDataFlavorSupported = (x.MimeType = attachmentType)
end function

'   ------------------------------------------------------------------------------------------------
Last edited by splashboard on Wed Feb 05, 2014 11:47 pm, edited 1 time in total.
Apache OpenOffice 4.0.1
Windows 7 Home Premium
splashboard
 
Posts: 14
Joined: Sat Feb 01, 2014 1:06 pm

Re: send email with Subject & Body text

Postby RPG » Mon Feb 03, 2014 9:04 pm

Hello

I do never send mail merge to other persons. On this moment I have no file to test it. But can you make clear why you can not use the normal wizard for an mail merge.

From a text document
menu --> tools --> Mail merge wizard

When you want continue with macros then I think you need one service:
MailAgent=CreateUnoService("com.sun.star.system.SimpleCommandMail")

https://forum.openoffice.org/en/forum/v ... 39&t=43162
In the link above there you find a lot of information.

Romke
LibreOffice 6.2.5.2 on openSUSE Leap 15
RPG
Volunteer
 
Posts: 2171
Joined: Tue Apr 14, 2009 7:15 pm
Location: Netherlands

Re: send email with Subject & Body text

Postby splashboard » Mon Feb 03, 2014 9:32 pm

Hello,
Thanks for the reply. I'm new to OpenOffice, so may be a bit slow to understand. I have looked at the link you supplied, but I cannot see where the "com.sun.star.system.simplecommandmail" routine allows you to add the subject or body texts to an e-mail. Could you give some code line examples of how it would work?
Jeff
Apache OpenOffice 4.0.1
Windows 7 Home Premium
splashboard
 
Posts: 14
Joined: Sat Feb 01, 2014 1:06 pm

Re: Send email with Subject & Body text

Postby RPG » Mon Feb 03, 2014 11:48 pm

Hello

I think start reading the link and try to understand what there is done.

http://www.openoffice.org/api/docs/comm ... ssage.html

Romke
LibreOffice 6.2.5.2 on openSUSE Leap 15
RPG
Volunteer
 
Posts: 2171
Joined: Tue Apr 14, 2009 7:15 pm
Location: Netherlands

Re: Send email with Subject & Body text

Postby splashboard » Tue Feb 04, 2014 9:41 pm

Hello,
I've tried the command that you suggested ( MailAgent=CreateUnoService("com.sun.star.system.SimpleCommandMail") ) but when executed it returns Null. Therefore the next command ( MailClient=MailAgent.querySimpleMailClient ) fails.

I've read the article & all the related services and interfaces that I could find, but could find no reference to the SimpleCommandMail.

I'm having difficulty in understanding the structure of these functions, what parameters or arguments they require and I was hoping for some example code to help me get to grips with it.

Jeff
Apache OpenOffice 4.0.1
Windows 7 Home Premium
splashboard
 
Posts: 14
Joined: Sat Feb 01, 2014 1:06 pm

Re: Send email with Subject & Body text

Postby RPG » Tue Feb 04, 2014 10:47 pm

Hello

splashboard wrote:it returns Null.
The reason it returns null is maybe that you have no client for emails on your computer. I think you need thunderbird or something thing else. Possible you need also an other email adress then gmail but maybe it can work.

I do not know if the client for email must be configured in OOo or it is enough when it is configured in your system.

On this moment I have no solution for sending an email body. The code I have on this moment is only code I'm testing. I think it is not such a good idea for writing the code in the way we do now. There is a service for mailmerge and it is maybe better to use that service but I do not know if I want spent the time for understanding that service there I do not need it. The code below is only for testing and does not work good.
Code: Select all   Expand viewCollapse view
Sub openEmailClient(Event As Object)
    Dim MailClient, MailAgent,MailMessage As Object
    dim mTo
    Dim UI As Integer
    MailAgent=CreateUnoService("com.sun.star.system.SimpleCommandMail")
    mri thiscomponent : end
    'print typename(MailAgent) : end
    'MailClient=MailAgent.querySimpleMailClient
    'if typename(MailClient) <> "Object" then print "We cannot work" : end ' test for mailclient

   ' there is a mail client now fill parts
    MailMessage=MailAgent.createSimpleMailMessage
   dim sRecipients
sRecipients ="filin an adres@gmail.com"
     MailMessage.setRecipient(sRecipients)
     MailMessage.setCcRecipient(array(sRecipients,";"))
     MailMessage.setBCcRecipient(array(sRecipients,";"))
     MailMessage.setSubject("I want see this message")
     MailMessage.Originator("Where is this going")
     mri MailMessage : end
     UI=0
' the UI flag indicates if the mail client user interface is to be opened (0) or sent
' w/o opening (1).  If you select 1, your email client may open a confirmation box
' indicating someone is trying to send an email--sometimes it is not the top most window.
' if nothing seems to happen, your email client may be waiting for you to respond you can
' set your email client to always allow an application to send emails - but may be a security issue
     MailAgent.sendSimpleMailMessage(MailMessage, UI)
     MailAgent.body=" Hallo ik wil deze tekst graag zien"




end
'   On Error Goto HandleError
   ' code bound to 'Mouse Button Pressed' of a Text Box
    Dim frm,oGrid
   frm=ThisComponent.Drawpage.Forms.getByName("UpdateGridForm")
   oGrid=frm.getbyname("TableToChange")
   mTo = oGrid.getByName("Email")
mri MailClient
     MailAgent.sendSimpleMailMessage(MailMessage,true)
     
    ' MailClient=MailAgent.querySimpleMailClient()
     'MailMessage=MailClient.createSimpleMailMessage()
' zien   MailAgent

end
HandleError:
  If err<>0 Then
    Exit Sub
  End If     
End Sub


Romke
LibreOffice 6.2.5.2 on openSUSE Leap 15
RPG
Volunteer
 
Posts: 2171
Joined: Tue Apr 14, 2009 7:15 pm
Location: Netherlands

Re: Send email with Subject & Body text

Postby splashboard » Wed Feb 05, 2014 12:20 am

Hello,
Thanks for your reply. I'll leave it for now and perhaps try to call Outlook via a shell command as I do on my Access database.
Jeff
Apache OpenOffice 4.0.1
Windows 7 Home Premium
splashboard
 
Posts: 14
Joined: Sat Feb 01, 2014 1:06 pm

Re: Send email with Subject & Body text

Postby splashboard » Wed Feb 05, 2014 11:46 pm

Hello again,
I had another try with your code using the smtp server [ sub sendMail(recipient, subject, body, Optional attachmentUrl) ] having amended it to link to my internet service provider's outgoing mail server, with it's port etc and my email address. It worked! Brilliant! Many thanks for supplying the information and advice.

I'll mark this as solved.

:bravo:

Jeff
Apache OpenOffice 4.0.1
Windows 7 Home Premium
splashboard
 
Posts: 14
Joined: Sat Feb 01, 2014 1:06 pm

Re: (Solved) Send email with Subject & Body text

Postby RPG » Thu Feb 06, 2014 12:07 am

Hello

It is nice you found a solution.
I think place your code in this tread or in the other. When you place your code in the other thread then other people do have an good example and a lot of information about sending emails.

Romke
LibreOffice 6.2.5.2 on openSUSE Leap 15
RPG
Volunteer
 
Posts: 2171
Joined: Tue Apr 14, 2009 7:15 pm
Location: Netherlands

Re: [Solved] Send email with Subject & Body text

Postby splashboard » Thu Feb 06, 2014 5:01 pm

Hello,
Here's the code that I used to to successfully send emails. I have not tried it with an attachment so far. I have amended it to remove my personal details. I hope that's OK.

Code: Select all   Expand viewCollapse view
REM  *****  BASIC  *****

'   email routines

'   ------------------------------------------------------------------------------------------------
sub Testmail
   smtpPassword = inputBox("Password", "Password:", "")      ' Alternatively set this as a const variable to save repetitive re-input
   
   attachmentType = "application/pdf"   'I have not tested these routines with an attachment!
'   sendMail(testRecipient, "Attachment", "Test the first", _
'      ConvertToUrl("c:\Documents and Settings\James\Desktop\test.pdf"))
   sendMail(testRecipient, "Test email subject", "Test email body text")
end sub

' ======== your details go here ========
   global const myAddress = "username@emailserver.com" ' amend to your email address. Used to fill sent from field n email
   global const smtpServer = "smtp.emailserver.com"      ' amend to your email server's address
   global const smtpPort = 25   'Your server's outgoing email port
   global const smtpTimeout = 60   ' Wait time in seconds
   global const smtpSecure = false   ' True or false depending on your server's parameters
   global const smtpUser = "username@emailserver.com" ' amend to your email address
   global const smtpPassword = "your email account password"   'Or set dynamically via input box above

   global const testRecipient = "valid sendto address"   'Set as constant here for testing or set dynamically from your own database records

   global const attachmentMaxSize = 100000

' these variables are needed by listener functions, to which they cannot be passed as arguments
   global smtpPassword as String   'required if used in conjunction with inputbox above else just use the const variable above
   global messageBody as String
   global attachmentContents as Object
   global attachmentType as object


sub sendMail(recipient, subject, body, Optional attachmentUrl)
   on error goto errorhandler
   
   dim bodyObject as Object, attachment as Object, message as Object, _
   serviceProvider as Object, service as Object, server as Object, mailUser as Object
   bodyObject = CreateUNOListener("body_", "com.sun.star.datatransfer.XTransferable")
   messageBody = body

   if not IsMissing(attachmentUrl) then
      if attachmentFromUrl(attachment, attachmentUrl) <> "OK" then
         exit sub
      end if
   end if

   message = com.sun.star.mail.MailMessage.createWithAttachment(recipient, myAddress, subject, bodyObject, attachment)
   serviceProvider = CreateUNOService("com.sun.star.mail.MailServiceProvider")
   service = serviceProvider.Create("com.sun.star.mail.SMTP")
   server = CreateUNOListener("smtp_", "com.sun.star.uno.XCurrentContext")
   mailUser = CreateUNOListener("user_", "com.sun.star.mail.XAuthenticator")

   service.Connect(server, mailUser)
   service.SendMailMessage(message)
   service.Disconnect()
   exit sub
   
errorhandler:
   msgbox "Error " & error()
      
end sub

'   --------------------------------------------------------------------------------------------------------

function attachmentFromUrl(attachment, url)
   dim chunks() as String, fileName as String, fileService as Object, _
   attachmentFile as Object, fileContents() as Byte

   chunks() = Split(url, "/")
   fileName = ConvertFromUrl(chunks(UBound(chunks()))

   fileService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
   attachmentFile = fileService.OpenFileRead(url)
   attachmentFile.ReadBytes(fileContents(), attachmentMaxSize + 1)
   attachmentFile.CloseInput

   if (UBound(fileContents()) + 1 > attachmentMaxSize) then
      msgBox "Attachment file '" & fileName & "' is too big"
      exit function
   elseIf (UBound(fileContents()) < 0) then
      msgBox "Attachment file '" & fileName & "' is empty"
      exit function
   end if

     attachmentContents = CreateUnoValue( "[]byte", fileContents())
   attachment = CreateObject("com.sun.star.mail.MailAttachment")
   attachment.Data = CreateUNOListener("attachment_", "com.sun.star.datatransfer.XTransferable")
   attachment.ReadableName = fileName

   attachmentFromUrl = "OK"
end function

' ===== server properties =====

'   ------------------------------------------------------------------------------------------------

function smtp_GetValueByName(what)
   select case what
      case "ServerName"
         smtp_GetValueByName = smtpServer
      case "Port"
         smtp_GetValueByName = smtpPort
      case "Timeout"
         smtp_GetValueByName = smtpTimeout
      case "ConnectionType"
         if smtpSecure then
            smtp_GetValueByName = "SSL"
         else
            smtp_GetValueByName = "Insecure"
         endif
   end select
end function

' ====== email user methods =======

'   ------------------------------------------------------------------------------------------------

function user_GetUserName()
   user_GetUserName = smtpUser
end function

'   ------------------------------------------------------------------------------------------------

function user_GetPassword()
   user_GetPassword = smtpPassword
end function

' ====== message body object methods ======

'   ------------------------------------------------------------------------------------------------

function body_GetTransferDataFlavors()
   dim flavor as new com.sun.star.datatransfer.DataFlavor
   flavor.MimeType = "text/plain;charset=utf-16"
   flavor.HumanPresentableName = "Unicode text"
   body_getTransferDataFlavors = Array(flavor)
end function

'   ------------------------------------------------------------------------------------------------

function body_GetTransferData(flavor) as any
   if (flavor.MimeType = "text/plain;charset=utf-16") then
      body_GetTransferData = messageBody
   end if
end function

'   ------------------------------------------------------------------------------------------------

function body_isDataFlavorSupported(x as Object)
   body_isDataFlavorSupported = (x.MimeType = "text/plain;charset=utf-16")
end function

' ====== attachment object methods ======

'   ------------------------------------------------------------------------------------------------

function attachment_GetTransferDataFlavors()
   dim flavor as new com.sun.star.datatransfer.DataFlavor
   flavor.MimeType = attachmentType
   flavor.HumanPresentableName = attachmentType
   attachment_getTransferDataFlavors = Array(flavor)
end function

'   ------------------------------------------------------------------------------------------------

function attachment_GetTransferData(flavor) as any
   if (flavor.MimeType = attachmentType) then
      attachment_GetTransferData = attachmentContents
   end if
end function

'   ------------------------------------------------------------------------------------------------

function attachment_isDataFlavorSupported(x as Object)
   attachment_isDataFlavorSupported = (x.MimeType = attachmentType)
end function

Apache OpenOffice 4.0.1
Windows 7 Home Premium
splashboard
 
Posts: 14
Joined: Sat Feb 01, 2014 1:06 pm

Re: [Solved] Send email with Subject & Body text

Postby Nocton » Fri Feb 07, 2014 9:11 pm

I know that a solution has been found, but if you have an email client available, e.g. Thunderbird, then the ordinary Mailto command will do what you want, I think. I have several databases which mail to individual members or groups of members. All I do, is use code to set up the URL for a command button. E.g.
Code: Select all   Expand viewCollapse view
oBtn.TargetURL = "mailto:" & cEmailMasterAddress & "?cc=" & cEmailAddresses & "&subject=" & "SUBJECTTEXT"

or
Code: Select all   Expand viewCollapse view
oBtn.TargetURL = "mailto:" & cEmailAddress & "?body=" & "BODYTEXT"

I think Mailto can do everything you want including attachments.

Regards,

Nocton
OpenOffice 4.2.0 on Windows 10
Nocton
Volunteer
 
Posts: 505
Joined: Fri Nov 05, 2010 10:27 am
Location: UK


Return to Base

Who is online

Users browsing this forum: No registered users and 3 guests