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 Sub Main BasicLibraries.LoadLibrary("Tools") TemplateDialog = LoadDialog("Template", "TemplateDialog") DialogModel = TemplateDialog.Model DialogModel.Step = 2 DialogModel.Optmerge.State = True LoadLanguageCorrespondence() TemplateDialog.Execute End Sub Function LoadLanguageCorrespondence() as Boolean If InitResources("'Template'", "tpl") Then msgNoTextmark$ = GetResText(1303) & Chr(13) & Chr(10) & GetResText(1301) msgError$ = GetResText(1302) 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) 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 bDBFields as Boolean 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 oFields as Object Dim oDocSettings as Object bDBFields = DialogModel.Optmerge.State 'db oder PLatzhalter If bDBFields Then oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/") sAddressbook = oDBAccess.DataSourceName If sAddressbook = "" Then oAddressDialog = CreateUnoService("com.sun.star.ui.AddressBookSourceDialog") oAddressDialog.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 TemplateDialog.EndExecute() DialogExited = TRUE ParaBreak = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK oDocument = StarDesktop.ActiveFrame.Controller.Model If bDBFields Then 'set the address db as current db at the document oDocSettings = oDocument.createInstance("com.sun.star.document.DocumentSettings") 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 = 0 To oFoundAll.Count - 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) 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 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 If sColname <> "" Then 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 oFieldMaster.PlaceHolder = sColName End Select oFieldMaster.Hint = getResText(1350) oBookText.InsertTextContent(oBookMarkCursor, oFieldMaster, True) End If End Sub