[Solved] Send email with Subject & Body text

[splashboard]

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)]

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

My code is: -

Code: Select all

'	************************************************************************************************
'	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

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

[RPG]

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")

viewtopic.php?f=39&t=43162
In the link above there you find a lot of information.

Romke

[splashboard]

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

[RPG]

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

[splashboard]

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

[RPG]

Hello

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

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

[splashboard]

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

[splashboard]

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.



Jeff

[RPG]

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

[splashboard]

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

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

[Nocton]

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

oBtn.TargetURL = "mailto:" & cEmailMasterAddress & "?cc=" & cEmailAddresses & "&subject=" & "SUBJECTTEXT"

or

Code: Select all

oBtn.TargetURL = "mailto:" & cEmailAddress & "?body=" & "BODYTEXT" 

I think Mailto can do everything you want including attachments.

Regards,

Nocton