yves dutrieux a écrit :
Bonsoir Michel,
Le 16 février 2010 09:24, Michel <[email protected]> a écrit :
Bonjour
J'ai une macro qui fusionne automatiquement un publipostage à partir d'un
logiciel métier INSER (gestion formation).
Pas de souci avec la version 3.1.1 et précédante.
Cela ne fonctionne plus avec la version 3.2.
XP sp3
Des pistes de changement dans le code ?
Il faudrait qu'on dispose de ton code si possible...
Bonjour
Openoffice plante direct sans message d'erreur.
La macro exécute une fusion, répertorie la base dans un fichier .TXT et
fait une copie du fichier .odt dans un dossier.
Une macro autoclose
Une macro autoOpen
Option Explicit
Private Sub AutoOpen()
Dim curDocument As Object '--- Document Courant
Dim InsInstance As Object '--- Instance de la base de données sources
Dim DbcDataBase As Object '--- base de données source
Dim MmgMailMerge As Object '--- objet de gestion de la fusion
Dim PpvInstancePrioriter(1) As New
com.sun.star.beans.PropertyValue '--- propriétés d'instances de base
de données
Dim PpvDatabaseInfo(3) As New com.sun.star.beans.PropertyValue
'--- Proriétés de la base de données
Dim PpvDocumentProprieter(1) As New
com.sun.star.beans.PropertyValue'--- proprités du document fusionné que
l'on ouvre
Dim IntPos As Integer ' compteur pour les boucles
Dim strFilePrefixName As String '-- préfixe du fichier (NOM sans
l'extension)
Dim strTemplateName As String '--- Nom du fichier modèle
Dim strTemplateFolder As String '--- Dossier de stockage du modèle
de document
Dim strDestinationFolder As String '--- Répoertoire de destiantion
Dim strOutput As String '--- Fichier de Sortie
MODELE_DDMMYY_HHMMSS.odt
On Error GoTo Err_AutoOpen
curDocument = ThisComponent
strTemplateName = curDocument.URL '--- Récupération du nom de fichier
'--- s'il s'agit d'une modèle CALC on sort
Select Case UCase(Right(strTemplateName,3))
Case "ODT"
Goto Exit_AutoOpen
End Select
'--- Construction des différents chemin
For IntPos = Len(strTemplateName) To 1 Step -1
Select Case Mid(strTemplateName,IntPos,1)
Case "\","/"
strTemplateFolder = Left(strTemplateName,IntPos)
strDestinationFolder = Left(strTemplateName,IntPos) &
"LETTRETYPE/"
strFilePrefixName =
Mid(strTemplateName,IntPos+1,Len(strTemplateName)-IntPos-4)
If FileExists("strDestinationFolder") = False Then
mkdir(strTemplateFolder & "LETTRETYPE")
end if
Exit For
End Select
Next
'--- Création de la base de données de ODB (il s'agit d'une
interface en les fichier TEXTE et le docuement sWriter
DbcDataBase = createUnoService("com.sun.star.sdb.DatabaseContext")
Select Case DbcDataBase.hasByName(strFilePrefixName)
Case True
DbcDataBase.revokeObject(strFilePrefixName)
End Select
PpvInstancePrioriter(0).Name = "Overwrite"
PpvInstancePrioriter(0).Value = True
InsInstance = DbcDataBase.createInstance()
InsInstance.URL = "sdbc:flat:" + strTemplateFolder
'--- Création des propriétés de la base de données
PpvDatabaseInfo(0).Name = "DecimalDelimiter" ' symbole décimal
PpvDatabaseInfo(0).Value = "."
PpvDatabaseInfo(1).Name = "Extension" ' extention dezs
fchier TEXTE source
PpvDatabaseInfo(1).Value = "TXT"
PpvDatabaseInfo(2).Name = "FieldDelimiter" ' délimiter de champs
PpvDatabaseInfo(2).Value = Chr(9)
PpvDatabaseInfo(3).Name = "StringDelimiter" ' délimiteur des
chaînes
PpvDatabaseInfo(3).Value = ""
InsInstance.Info() = PpvDatabaseInfo ' affectation des
propriétés
InsInstance.DatabaseDocument.storeAsURL(strTemplateFolder +
strFilePrefixName + ".odb",PpvInstancePrioriter()) ' chemin de stocakge
DbcDataBase.registerObject(strFilePrefixName,InsInstance)
'--- Paramétrage de la fusion
MmgMailMerge = createUnoService("com.sun.star.text.MailMerge")
MmgMailMerge.DataSourceName = strFilePrefixName
MmgMailMerge.DocumentURL = strTemplateName
MmgMailMerge.CommandType = 0
MmgMailMerge.Command = strFilePrefixName
MmgMailMerge.OutputType = 2
MmgMailMerge.OutputURL = strDestinationFolder
strOutput = strFilePrefixName & "_" &
Format(Now(),"ddmmyy\_hhmmss") ' construction du nom de sorite
MmgMailMerge.FileNamePrefix = strOutput
MmgMailMerge.SaveAsSingleFile = True
MmgMailMerge.Execute (Array()) '
rélisation de la fusion le doc estcréée
'--- Ouverture du document fusionné
PpvDocumentProprieter(0).Name = "MacroExecutionMode"
PpvDocumentProprieter(0).Value = 0
PpvDocumentProprieter(1).Name = "AsTemplate"
PpvDocumentProprieter(1).Value = 0
curDocument = StarDesktop.LoadComponentFromURL(strDestinationFolder
+ strOutput + "0.odt", "_blank", 0, PpvDocumentProprieter())
ThisComponent.Close(True)
'--- Désallocation avant sortie
Exit_AutoOpen:
Set curDocument = Nothing
Set InsInstance = Nothing
Set DbcDataBase = Nothing
Set MmgMailMerge = Nothing
Set PpvInstancePrioriter(0) = Nothing
Set PpvInstancePrioriter(1) = Nothing
Set PpvDatabaseInfo(0) = Nothing
Set PpvDatabaseInfo(1) = Nothing
Set PpvDatabaseInfo(2) = Nothing
Set PpvDatabaseInfo(3) = Nothing
Set PpvDocumentProprieter(0) = Nothing
Set PpvDocumentProprieter(1) = Nothing
Exit Sub
'--- Erreur
Err_AutoOpen:
MsgBox Err & " " & Error$ & " " & Erl
Resume Exit_AutoOpen
End Sub
Merci
Michel
en +, affiche-t-il un message d'erreur ? est-ce que le code bloque à un
certain endroit et si oui, lequel ?
Le publipostage est fait à partir de quels logiciels : Writer + fichiers
csv/txt/ods/odb ?
Yves
Merci
Michel
--
Soyez eco-citoyen : n'imprimez ce mail que si necessaire.
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
--
Soyez eco-citoyen : n'imprimez ce mail que si necessaire.
