Quelle  Correspondence.xba   Sprache: unbekannt

<?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'") Then
  msgNoTextmark$ = GetResText("CorrespondenceDialog_0") & Chr(13) & Chr(10) & GetResText("CorrespondenceNoTextmark_1")
  msgError$ = GetResText("CorrespondenceMsgError")
  If bTemplate Then
   DialogModel.Title = GetResText("CorrespondenceDialog_3")
   DialogModel.CmdCancel.Label = GetResText("STYLES_2")
   DialogModel.CmdCorrGoOn.Label = GetResText("STYLES_3")
   DialogModel.OptSingle.Label = GetResText("CorrespondenceDialog_1")
   DialogModel.Optmerge.Label = GetResText("CorrespondenceDialog_2")
   DialogModel.FrmLetter.Label = GetResText("CorrespondenceDialog_0")
  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("CorrespondenceNoTextmark_1"))
    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("CorrespondenceFields_1")
   Case "Department"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_2")
   Case "FirstName"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_3")
   Case "LastName"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_4")
   Case "Street"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_5")
   Case "Country"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_6")
   Case "Zip"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_7")
   Case "City"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_8")
   Case "Title"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_9")
   Case "Position"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_10")
   Case "AddrForm"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_11")
   Case "Code"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_12")
   Case "AddrFormMail"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_13")
   Case "PhonePriv"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_14")
   Case "PhoneComp"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_15")
   Case "Fax"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_16")
   Case "EMail"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_17")
   Case "URL"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_18")
   Case "Note"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_19")
   Case "Altfield1"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_20")
   Case "Altfield2"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_21")
   Case "Altfield3"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_22")
   Case "Altfield4"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_23")
   Case "Id"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_24")
   Case "State"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_25")
   Case "PhoneOffice"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_26")
   Case "Pager"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_27")
   Case "PhoneCell"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_28")
   Case "PhoneOther"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_29")
   Case "CalendarURL"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_30")
   Case "InviteParticipant"
    oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_31")
   Case Else
    bCorrectField = False
  End Select
  If bCorrectField Then
   oFieldMaster.Hint = getResText("CorrespondenceFields_0")
   oBookText.InsertTextContent(oBookMarkCursor, oFieldMaster, True)
  End If
 End If
End Sub
</script:module>