home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 January / PCWorld_2004-01_cd.bin / akce / openoffice / f_0282 / Correspondence.xba < prev    next >
Extensible Markup Language  |  2003-03-27  |  9KB  |  263 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Correspondence" script:language="StarBasic">Option Explicit
  4.  
  5. Public msgNoTextmark$, msgError$
  6. Public sAddressbook$
  7. Public Table
  8. Public sCompany$, sFirstName$, sLastName$, sStreet$, sPostalCode$, sCity$, sState$, sInitials$, sPosition$
  9. Public DialogExited
  10. Public oDocument, oText, oBookMarks, oBookMark, oBookMarkCursor, oBookText as Object
  11.  
  12. Sub Main
  13.     BasicLibraries.LoadLibrary("Tools")
  14.     TemplateDialog = LoadDialog("Template", "TemplateDialog")
  15.     DialogModel = TemplateDialog.Model
  16.     DialogModel.Step = 2
  17.     DialogModel.Optmerge.State = True
  18.     LoadLanguageCorrespondence()
  19.     TemplateDialog.Execute
  20.     TemplateDialog.Dispose()
  21. End Sub
  22.  
  23.  
  24. Function LoadLanguageCorrespondence() as Boolean
  25.     If InitResources("'Template'", "tpl") Then
  26.         msgNoTextmark$ = GetResText(1303) & Chr(13) & Chr(10) & GetResText(1301)
  27.         msgError$ = GetResText(1302)
  28.         DialogModel.Title = GetResText(1303+3)
  29.         DialogModel.CmdCancel.Label = GetResText(1102)
  30.         DialogModel.CmdCorrGoOn.Label = GetResText(1103)
  31.         DialogModel.OptSingle.Label = GetResText(1303 + 1)
  32.         DialogModel.Optmerge.Label = GetResText(1303 + 2)
  33.         DialogModel.FrmLetter.Label = GetResText(1303)
  34.         LoadLanguageCorrespondence() = True
  35.     Else
  36.         msgbox("Warning: Resource could not be loaded!")
  37.     End If
  38. End Function
  39.  
  40.  
  41. Function GetFieldName(oFieldKnot as Object, GeneralFieldName as String)
  42.     If oFieldKnot.HasByName(GeneralFieldName) Then
  43.     GetFieldName = oFieldKnot.GetByName(GeneralFieldName).AssignedFieldName
  44.     Else
  45.         GetFieldName = ""
  46.     End If
  47. End Function
  48.  
  49.  
  50. Sub OK
  51. Dim ParaBreak
  52. Dim sDocLang as String
  53. Dim bDBFields as Boolean
  54. Dim oSearchDesc as Object
  55. Dim oFoundAll as Object
  56. Dim oFound as Object
  57. Dim sFoundContent as String
  58. Dim sFoundString as String
  59. Dim sDBField as String
  60. Dim i as Integer
  61. Dim oDBAccess as Object
  62. Dim oAddressDialog as Object
  63. Dim oAddressPilot as Object
  64. Dim oFields as Object
  65. Dim oDocSettings as Object
  66. Dim oContext as Object
  67. Dim bDBvalid as Boolean
  68.     'On Local Error Goto GENERALERROR
  69.     bDBFields = DialogModel.Optmerge.State              'database or placeholder
  70.     
  71.     TemplateDialog.EndExecute()
  72.     DialogExited = TRUE
  73.  
  74.     If bDBFields Then
  75.         oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/")
  76.         sAddressbook = oDBAccess.DataSourceName
  77.  
  78.         bDBvalid = false
  79.         oContext = createUnoService( "com.sun.star.sdb.DatabaseContext" )        
  80.  
  81.         If (not isNull(oContext)) Then 
  82.             'Is the previously assigned address data source still valid?
  83.             bDBvalid = oContext.hasByName(sAddressbook)
  84.         end if
  85.                 
  86.         If (bDBvalid = false) Then            
  87.             oAddressPilot = createUnoService("com.sun.star.ui.dialogs.AddressBookSourcePilot")
  88.             oAddressPilot.execute
  89.             
  90.             oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/")
  91.             sAddressbook = oDBAccess.DataSourceName
  92.             If sAddressbook = "" Then
  93.                 MsgBox(GetResText(1301))
  94.                 Exit Sub
  95.             End If
  96.         End If
  97.         oFields = oDBAccess.GetByName("Fields")
  98.         Table = oDBAccess.GetByName("Command")
  99.     End If
  100.  
  101.     ParaBreak = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK
  102.       oDocument = ThisComponent
  103.     If bDBFields Then
  104.         'set the address db as current db at the document
  105.         oDocSettings = oDocument.createInstance("com.sun.star.document.Settings")
  106.         oDocSettings.CurrentDatabaseDataSource = sAddressbook
  107.         oDocSettings.CurrentDatabaseCommand = Table
  108.         oDocSettings.CurrentDatabaseCommandType = 0
  109.     End If
  110.     oBookmarks = oDocument.Bookmarks
  111.     oText = oDocument.Text
  112.  
  113.     oSearchDesc = oDocument.createsearchDescriptor()
  114.     oSearchDesc.SearchRegularExpression = True
  115.     oSearchDesc.SearchWords = True
  116.     oSearchDesc.SearchString  = "<[^>]+>"
  117.     oFoundall = oDocument.FindAll(oSearchDesc)
  118.  
  119.     'Loop over the foundings
  120.       For i = oFoundAll.Count -1 To 0 Step -1
  121.         oFound = oFoundAll.GetByIndex(i)
  122.         sFoundString = oFound.String
  123.         'Extract the string inside the brackets
  124.         sFoundContent = FindPartString(sFoundString,"<",">",1)
  125.         sFoundContent = LTrim(sFoundContent)
  126.         ' Define the Cursor and place it on the founding
  127.         oBookmarkCursor = oFound.Text.CreateTextCursorbyRange(oFound)
  128.         oBookText = oFound.Text
  129.         If bDBFields Then
  130.             sDBField = GetFieldname(oFields, sFoundContent)
  131.             If sDBField <> "" Then
  132.                 InsertDBField(sAddressbook, Table, sDBField)
  133.             Else
  134.                 InsertPlaceholder(sFoundContent)
  135.             End If
  136.         Else
  137.             InsertPlaceholder(sFoundContent)
  138.         End If
  139.     Next i
  140.     If bDBFields Then
  141.         'Open the DB beamer with the right DB
  142.         Dim oDisp as Object
  143.         Dim oTransformer
  144.         Dim aURL as new com.sun.star.util.URL
  145.         aURL.complete = ".component:DB/DataSourceBrowser"
  146.         oTransformer = createUnoService("com.sun.star.util.URLTransformer")
  147.         oTransformer.parseStrict(aURL)
  148.         oDisp = oDocument.getCurrentController.getFrame.queryDispatch(aURL, "_beamer", com.sun.star.frame.FrameSearchFlag.CHILDREN + com.sun.star.frame.FrameSearchFlag.CREATE)
  149.         Dim aArgs(3) as new com.sun.star.beans.PropertyValue
  150.         aArgs(1).Name = "DataSourceName"
  151.         aArgs(1).Value = sAddressbook
  152.         aArgs(2).Name = "CommandType"
  153.         aArgs(2).Value = com.sun.star.sdb.CommandType.TABLE
  154.         aArgs(3).Name = "Command"
  155.         aArgs(3).Value = Table
  156.         oDisp.dispatch(aURL, aArgs())
  157.     End If
  158.     
  159.     GENERALERROR:
  160.     If Err <> 0 Then
  161.         Msgbox(msgError$,16, GetProductName())
  162.         Resume LETSGO
  163.     End If
  164.     LETSGO:
  165.  
  166. End Sub
  167.  
  168.  
  169. Sub InsertDBField(sDBName as String, sTableName as String, sColName as String)
  170. Dim oFieldMaster, oField as Object
  171.     If sColname <> "" Then
  172.         oFieldMaster = oDocument.createInstance("com.sun.star.text.FieldMaster.Database")
  173.         oField = oDocument.createInstance("com.sun.star.text.TextField.Database")
  174.         oFieldMaster.DataBaseName = sDBName
  175.         oFieldMaster.DataBaseName = sDBName
  176.         oFieldMaster.DataTableName = sTableName
  177.         oFieldMaster.DataColumnName = sColName
  178.         oField.AttachTextfieldmaster (oFieldMaster)
  179.         oBookText.InsertTextContent(oBookMarkCursor, oField, True)
  180.         oField.Content = "<" & sColName & ">"
  181.     End If
  182. End Sub
  183.  
  184.  
  185. Sub InsertPlaceholder(sColName as String)
  186. Dim oFieldMaster as Object
  187. Dim bCorrectField as Boolean
  188.     If sColname <> "" Then
  189.         bCorrectField = True
  190.         oFieldMaster = oDocument.createInstance("com.sun.star.text.TextField.JumpEdit")
  191.         Select Case sColName
  192.             Case "Company"
  193.                 oFieldMaster.PlaceHolder = getResText(1350+1)
  194.             Case "Department"
  195.                 oFieldMaster.PlaceHolder = getResText(1350+2)
  196.             Case "FirstName"
  197.                 oFieldMaster.PlaceHolder = getResText(1350+3)
  198.             Case "LastName"
  199.                 oFieldMaster.PlaceHolder = getResText(1350+4)
  200.             Case "Street"
  201.                 oFieldMaster.PlaceHolder = getResText(1350+5)
  202.             Case "Country"
  203.                 oFieldMaster.PlaceHolder = getResText(1350+6)
  204.             Case "Zip"
  205.                 oFieldMaster.PlaceHolder = getResText(1350+7)
  206.             Case "City"
  207.                 oFieldMaster.PlaceHolder = getResText(1350+8)
  208.             Case "Title"
  209.                 oFieldMaster.PlaceHolder = getResText(1350+9)
  210.             Case "Position"
  211.                 oFieldMaster.PlaceHolder = getResText(1350+10)
  212.             Case "AddrForm"
  213.                 oFieldMaster.PlaceHolder = getResText(1350+11)
  214.             Case "Code"
  215.                 oFieldMaster.PlaceHolder = getResText(1350+12)
  216.             Case "AddrFormMail"
  217.                 oFieldMaster.PlaceHolder = getResText(1350+13)
  218.             Case "PhonePriv"
  219.                 oFieldMaster.PlaceHolder = getResText(1350+14)
  220.             Case "PhoneComp"
  221.                 oFieldMaster.PlaceHolder = getResText(1350+15)
  222.             Case "Fax"
  223.                 oFieldMaster.PlaceHolder = getResText(1350+16)
  224.             Case "EMail"
  225.                 oFieldMaster.PlaceHolder = getResText(1350+17)
  226.             Case "URL"
  227.                 oFieldMaster.PlaceHolder = getResText(1350+18)
  228.             Case "Note"
  229.                 oFieldMaster.PlaceHolder = getResText(1350+19)
  230.             Case "Altfield1"
  231.                 oFieldMaster.PlaceHolder = getResText(1350+20)
  232.             Case "Altfield2"
  233.                 oFieldMaster.PlaceHolder = getResText(1350+21)
  234.             Case "Altfield3"
  235.                 oFieldMaster.PlaceHolder = getResText(1350+22)
  236.             Case "Altfield4"
  237.                 oFieldMaster.PlaceHolder = getResText(1350+23)
  238.             Case "Id"
  239.                 oFieldMaster.PlaceHolder = getResText(1350+24)
  240.             Case "State"
  241.                 oFieldMaster.PlaceHolder = getResText(1350+25)
  242.             Case "PhoneOffice"
  243.                 oFieldMaster.PlaceHolder = getResText(1350+26)
  244.             Case "Pager"
  245.                 oFieldMaster.PlaceHolder = getResText(1350+27)
  246.             Case "PhoneCell"
  247.                 oFieldMaster.PlaceHolder = getResText(1350+28)
  248.             Case "PhoneOther"
  249.                 oFieldMaster.PlaceHolder = getResText(1350+29)
  250.             Case "CalendarURL"
  251.                 oFieldMaster.PlaceHolder = getResText(1350+30)
  252.             Case "InviteParticipant"
  253.                 oFieldMaster.PlaceHolder = getResText(1350+31)
  254.             Case Else
  255.                 bCorrectField = False
  256.         End Select
  257.         If bCorrectField Then
  258.             oFieldMaster.Hint = getResText(1350)
  259.             oBookText.InsertTextContent(oBookMarkCursor, oFieldMaster, True)
  260.         End If
  261.     End If
  262. End Sub
  263. </script:module>