EVOLUTION-MANAGER
Edit File: Correspondence.xba
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!-- * This file is part of the LibreOffice project. * * This Source Code Form is subject to the terms of the Mozilla Public * License, v. 2.0. If a copy of the MPL was not distributed with this * file, You can obtain one at http://mozilla.org/MPL/2.0/. * * This file incorporates work covered by the following license notice: * * Licensed to the Apache Software Foundation (ASF) under one or more * contributor license agreements. See the NOTICE file distributed * with this work for additional information regarding copyright * ownership. The ASF licenses this file to you under the Apache * License, Version 2.0 (the "License"); you may not use this file * except in compliance with the License. You may obtain a copy of * the License at http://www.apache.org/licenses/LICENSE-2.0 . --> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Correspondence" script:language="StarBasic">Option Explicit Public msgNoTextmark$, msgError$ Public sAddressbook$ Public Table Public sCompany$, sFirstName$, sLastName$, sStreet$, sPostalCode$, sCity$, sState$, sInitials$, sPosition$ Public DialogExited Public oDocument, oText, oBookMarks, oBookMark, oBookMarkCursor, oBookText as Object Public bTemplate, bDBFields as Boolean Sub Main bTemplate = true BasicLibraries.LoadLibrary("Tools") TemplateDialog = LoadDialog("Template", "TemplateDialog") DialogModel = TemplateDialog.Model DialogModel.Step = 2 DialogModel.Optmerge.State = True LoadLanguageCorrespondence() TemplateDialog.Execute TemplateDialog.Dispose() End Sub Sub Placeholder bTemplate = false BasicLibraries.LoadLibrary("Tools") LoadLanguageCorrespondence() bDBFields = false OK() End Sub Sub Database bTemplate = false BasicLibraries.LoadLibrary("Tools") LoadLanguageCorrespondence() bDBFields = true OK() End Sub Function LoadLanguageCorrespondence() as Boolean If InitResources("'Template'", "tpl") Then msgNoTextmark$ = GetResText(1303) & Chr(13) & Chr(10) & GetResText(1301) msgError$ = GetResText(1302) If bTemplate Then DialogModel.Title = GetResText(1303+3) DialogModel.CmdCancel.Label = GetResText(1102) DialogModel.CmdCorrGoOn.Label = GetResText(1103) DialogModel.OptSingle.Label = GetResText(1303 + 1) DialogModel.Optmerge.Label = GetResText(1303 + 2) DialogModel.FrmLetter.Label = GetResText(1303) End If LoadLanguageCorrespondence() = True Else msgbox("Warning: Resource could not be loaded!") End If End Function Function GetFieldName(oFieldKnot as Object, GeneralFieldName as String) If oFieldKnot.HasByName(GeneralFieldName) Then GetFieldName = oFieldKnot.GetByName(GeneralFieldName).AssignedFieldName Else GetFieldName = "" End If End Function Sub OK Dim ParaBreak Dim sDocLang as String Dim oSearchDesc as Object Dim oFoundAll as Object Dim oFound as Object Dim sFoundContent as String Dim sFoundString as String Dim sDBField as String Dim i as Integer Dim oDBAccess as Object Dim oAddressDialog as Object Dim oAddressPilot as Object Dim oFields as Object Dim oDocSettings as Object Dim oContext as Object Dim bDBvalid as Boolean 'On Local Error Goto GENERALERROR If bTemplate Then bDBFields = DialogModel.Optmerge.State 'database or placeholder TemplateDialog.EndExecute() DialogExited = TRUE End If If bDBFields Then oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/") sAddressbook = oDBAccess.DataSourceName bDBvalid = false oContext = createUnoService( "com.sun.star.sdb.DatabaseContext" ) If (not isNull(oContext)) Then 'Is the previously assigned address data source still valid? bDBvalid = oContext.hasByName(sAddressbook) end if If (bDBvalid = false) Then oAddressPilot = createUnoService("com.sun.star.ui.dialogs.AddressBookSourcePilot") oAddressPilot.execute oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/") sAddressbook = oDBAccess.DataSourceName If sAddressbook = "" Then MsgBox(GetResText(1301)) Exit Sub End If End If oFields = oDBAccess.GetByName("Fields") Table = oDBAccess.GetByName("Command") End If ParaBreak = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK oDocument = ThisComponent If bDBFields Then 'set the address db as current db at the document oDocSettings = oDocument.createInstance("com.sun.star.document.Settings") oDocSettings.CurrentDatabaseDataSource = sAddressbook oDocSettings.CurrentDatabaseCommand = Table oDocSettings.CurrentDatabaseCommandType = 0 End If oBookmarks = oDocument.Bookmarks oText = oDocument.Text oSearchDesc = oDocument.createsearchDescriptor() oSearchDesc.SearchRegularExpression = True oSearchDesc.SearchWords = True oSearchDesc.SearchString = "<[^>]+>" oFoundall = oDocument.FindAll(oSearchDesc) 'Loop over the foundings For i = oFoundAll.Count -1 To 0 Step -1 oFound = oFoundAll.GetByIndex(i) sFoundString = oFound.String 'Extract the string inside the brackets sFoundContent = FindPartString(sFoundString,"<",">",1) sFoundContent = LTrim(sFoundContent) ' Define the Cursor and place it on the founding oBookmarkCursor = oFound.Text.CreateTextCursorbyRange(oFound) oBookText = oFound.Text If bDBFields Then sDBField = GetFieldname(oFields, sFoundContent) If sDBField <> "" Then InsertDBField(sAddressbook, Table, sDBField) Else InsertPlaceholder(sFoundContent) End If Else InsertPlaceholder(sFoundContent) End If Next i If bDBFields Then 'Open the DB beamer with the right DB Dim oDisp as Object Dim oTransformer Dim aURL as new com.sun.star.util.URL aURL.complete = ".component:DB/DataSourceBrowser" oTransformer = createUnoService("com.sun.star.util.URLTransformer") oTransformer.parseStrict(aURL) oDisp = oDocument.getCurrentController.getFrame.queryDispatch(aURL, "_beamer", com.sun.star.frame.FrameSearchFlag.CHILDREN + com.sun.star.frame.FrameSearchFlag.CREATE) Dim aArgs(3) as new com.sun.star.beans.PropertyValue aArgs(1).Name = "DataSourceName" aArgs(1).Value = sAddressbook aArgs(2).Name = "CommandType" aArgs(2).Value = com.sun.star.sdb.CommandType.TABLE aArgs(3).Name = "Command" aArgs(3).Value = Table oDisp.dispatch(aURL, aArgs()) End If GENERALERROR: If Err <> 0 Then Msgbox(msgError$,16, GetProductName()) Resume LETSGO End If LETSGO: End Sub Sub InsertDBField(sDBName as String, sTableName as String, sColName as String) Dim oFieldMaster, oField as Object If sColname <> "" Then oFieldMaster = oDocument.createInstance("com.sun.star.text.FieldMaster.Database") oField = oDocument.createInstance("com.sun.star.text.TextField.Database") oFieldMaster.DataBaseName = sDBName oFieldMaster.DataBaseName = sDBName oFieldMaster.DataTableName = sTableName oFieldMaster.DataColumnName = sColName oField.AttachTextfieldmaster (oFieldMaster) oBookText.InsertTextContent(oBookMarkCursor, oField, True) oField.Content = "<" & sColName & ">" End If End Sub Sub InsertPlaceholder(sColName as String) Dim oFieldMaster as Object Dim bCorrectField as Boolean If sColname <> "" Then bCorrectField = True oFieldMaster = oDocument.createInstance("com.sun.star.text.TextField.JumpEdit") Select Case sColName Case "Company" oFieldMaster.PlaceHolder = getResText(1350+1) Case "Department" oFieldMaster.PlaceHolder = getResText(1350+2) Case "FirstName" oFieldMaster.PlaceHolder = getResText(1350+3) Case "LastName" oFieldMaster.PlaceHolder = getResText(1350+4) Case "Street" oFieldMaster.PlaceHolder = getResText(1350+5) Case "Country" oFieldMaster.PlaceHolder = getResText(1350+6) Case "Zip" oFieldMaster.PlaceHolder = getResText(1350+7) Case "City" oFieldMaster.PlaceHolder = getResText(1350+8) Case "Title" oFieldMaster.PlaceHolder = getResText(1350+9) Case "Position" oFieldMaster.PlaceHolder = getResText(1350+10) Case "AddrForm" oFieldMaster.PlaceHolder = getResText(1350+11) Case "Code" oFieldMaster.PlaceHolder = getResText(1350+12) Case "AddrFormMail" oFieldMaster.PlaceHolder = getResText(1350+13) Case "PhonePriv" oFieldMaster.PlaceHolder = getResText(1350+14) Case "PhoneComp" oFieldMaster.PlaceHolder = getResText(1350+15) Case "Fax" oFieldMaster.PlaceHolder = getResText(1350+16) Case "EMail" oFieldMaster.PlaceHolder = getResText(1350+17) Case "URL" oFieldMaster.PlaceHolder = getResText(1350+18) Case "Note" oFieldMaster.PlaceHolder = getResText(1350+19) Case "Altfield1" oFieldMaster.PlaceHolder = getResText(1350+20) Case "Altfield2" oFieldMaster.PlaceHolder = getResText(1350+21) Case "Altfield3" oFieldMaster.PlaceHolder = getResText(1350+22) Case "Altfield4" oFieldMaster.PlaceHolder = getResText(1350+23) Case "Id" oFieldMaster.PlaceHolder = getResText(1350+24) Case "State" oFieldMaster.PlaceHolder = getResText(1350+25) Case "PhoneOffice" oFieldMaster.PlaceHolder = getResText(1350+26) Case "Pager" oFieldMaster.PlaceHolder = getResText(1350+27) Case "PhoneCell" oFieldMaster.PlaceHolder = getResText(1350+28) Case "PhoneOther" oFieldMaster.PlaceHolder = getResText(1350+29) Case "CalendarURL" oFieldMaster.PlaceHolder = getResText(1350+30) Case "InviteParticipant" oFieldMaster.PlaceHolder = getResText(1350+31) Case Else bCorrectField = False End Select If bCorrectField Then oFieldMaster.Hint = getResText(1350) oBookText.InsertTextContent(oBookMarkCursor, oFieldMaster, True) End If End If End Sub </script:module>