Forum OpenOffice LibreOffice NeoOffice

Code : Tout sélectionner

Option Explicit

Sub CopiePourEnvoiParMail

	Dim sourceDoc As Object, sourceSheet As Object
	Dim destDoc As Object, 	destSheets As Object, destSheet As Object, maCellule as Object, destURL As String
	Dim aCopier as Object, sourceController As Object, destController As Object
	Dim Args(0) as new com.sun.star.beans.PropertyValue
	Dim sv As Object, unClient As Object, monMel As Object
	Dim path As String, formatedPath As String
	Dim today As Date
	Dim formatedDate As String
	Dim annexes(0) As String, nbF as long
	  
	sourceDoc = thisComponent
	sourceSheet = sourceDoc.getCurrentController().getActiveSheet()
	sourceController = sourceDoc.currentController
	sourceController.Select(sourceSheet)
	aCopier = sourceDoc.CurrentController.getTransferable()	
	destDoc = StarDesktop.LoadComponentFromURL("private:factory/scalc","_blank",0,array())
	destSheets = destDoc.Sheets
	nbF = destSheets.Count
	destSheet = destSheets.GetByIndex(0)
	maCellule = destSheet.getCellRangeByName("A1")  
	destController = destDoc.currentController
	destController.Select(maCellule)
	destController.insertTransferable(aCopier)
	destSheet.Name = sourceSheet.Name
	today = date()
	formatedDate = Format(today, "ddmmyyyy")
	GlobalScope.BasicLibraries.loadLibrary("Tools")
	path=DirectoryNameoutofPath(ThisComponent.getURL(),"/")
	formatedPath = Mid(path, 9 , Len(path))
	destURL = formatedPath & "/Tableaux Envoyés/" & destSheet.Name & "/envoi" & destSheet.Name & "_" & formatedDate & ".ods" 'à modifier bien sûr
	destURL = ConvertToURL(destURL)
	destDoc.StoreToUrl(destURL,array())
	on Error Resume Next ' ignorer l'erreur éventuelle
	destDoc.close(True)
	On Error GoTo 0 ' reprendre le traitement d'erreur normal
	sv = createUnoService("com.sun.star.system.SimpleSystemMail")
	unClient = sv.querySimpleMailClient
	if IsNull(unClient) then
		MsgBox("Client de messagerie non disponible", 16)
	stop
	end if
	monMel = unClient.createSimpleMailMessage
	with monMel ' évite de répéter monMel.xxxx
		.Subject= "Envoi d'une copie d'une feuille"
		annexes(0) = destUrl
		.Attachement= annexes()
	end with
	unClient.sendSimpleMailMessage(monMel, 0)
End Sub