cleanandvalidate/IPHRedaction/Clean.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Clean" script:language="StarBasic">Sub cleanButton
	Dim description As String
	Dim statusIndicator as Object
	statusIndicator = ThisComponent.getCurrentController.statusIndicator
	description = &quot;Вы уверены, что хотите выполнить чистку документа?&quot;
	If NOT confirm(description) Then
		Exit Sub
	EndIf
	saveDocument
	doNotTrack
	statusIndicator.Start(&quot;Чистка документа начата, подождите&quot;,30)
	cleanFormatting
	disposePageBreaks
	disposeAllLinks
	disposeAllBookmarks
	statusIndicator.end()
	saveAndreload()
End Sub

Private Sub disposeAllLinks()
	Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
	SrchAttributes(0).Name = &quot;CharStyleName&quot;
	SrchAttributes(0).Value = &quot;Internet Link&quot;
	Dim ReplAttributes(2) as new com.sun.star.beans.PropertyValue
	ReplAttributes(0).Name = &quot;HyperlinkTarget&quot;
	ReplAttributes(0).Value = &quot;&quot;
	ReplAttributes(1).Name = &quot;HyperLinkURL&quot;
	ReplAttributes(1).Value = &quot;&quot;
	ReplAttributes(2).Name = &quot;CharStyleName&quot;
	ReplAttributes(2).Value = ThisComponent.getStyleFamilies().getByIndex(0).ElementNames(0)
	setAttributesBySearchPattern(searchPattern,SrchAttributes,ReplAttributes)
End Sub

Private Sub disposeAllBookmarks()
	Dim bookmarks As Object
	Dim elementName As String
	elementName = ThisComponent.Links.ElementNames(6)
	bookmarks = ThisComponent.Links.getByName(elementName)
	While bookmarks.hasElements()
		bookmark = bookmarks.getByName(bookmarks.ElementNames(0))
		bookmark.dispose()
	Wend
End Sub


Private Sub disposePageBreaks
	oTextCursor = ThisComponent.Text.CreateTextCursor()
	enum1 = ThisComponent.Text.createEnumeration
	While enum1.hasMoreElements
		enum1Element = enum1.nextElement
		If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
			If enum1Element.BreakType &lt;&gt; com.sun.star.style.BreakType.NONE Then
				oTextCursor.goToRange(enum1Element.getAnchor(), false)
				If NOT IsEmpty(oTextCursor.PageDescName) Then
					oTextCursor.PageDescName = &quot;&quot;
				End If
				oTextCursor.BreakType = com.sun.star.style.BreakType.NONE
			End If
		ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
			If NOT IsEmpty(enum1Element.PageDescName) Then
				enum1Element.PageDescName = &quot;&quot;
			End If
			enum1Element.BreakType = com.sun.star.style.BreakType.NONE
		EndIf
	Wend
End Sub

Private Sub setAttributesBySearchPattern(searchPattern As String, SrchAttributes, ReplAttributes)
	
	Dim oSearch
	Dim oTextCursor As Object 
	Dim oViewCursor As Object
	Dim lineIndent
	Dim foundPatterns() As Object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	oSearch = ThisComponent.createSearchDescriptor()
	oSearch.SearchString = searchPattern
	oSearch.SearchRegularExpression=True
    oSearch.SearchAll = True
    oSearch.searchStyles = true
    If Not IsEmpty(SrchAttributes(0).Value) Then
      oSearch.SetSearchAttributes(SrchAttributes())
    End If
	oFound = ThisComponent.findFirst(oSearch)
	Do While Not IsNull(oFound)
	  For i = LBound(ReplAttributes) To Ubound(ReplAttributes)
  	&apos;	Globalscope.BasicLibraries.LoadLibrary( &quot;MRILib&quot; )
	&apos;  	Mri oFound
	  	If oFound.getPropertySetInfo.hasPropertyByName(ReplAttributes(i).Name) Then
		  oFound.SetPropertyValue(ReplAttributes(i).Name,ReplAttributes(i).Value)
		EndIf
	  Next i	  
	  oFound = ThisComponent.findNext(oFound.End, oSearch)
	Loop

End Sub

Private Sub saveAndreload()

	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:Save&quot;, &quot;&quot;, 0, Array())
	dispatcher.executeDispatch(document, &quot;.uno:Reload&quot;, &quot;&quot;, 0, Array())

End Sub

Private Sub saveDocument()

	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dispatcher.executeDispatch(document, &quot;.uno:Save&quot;, &quot;&quot;, 0, Array())

end Sub

Private Sub cleanFormatting

	&apos;Не должно быть символов табуляции
    AskAndReplace(&quot;\t&quot;,&quot;&quot;)
    &apos;Не должно быть подряд больше одного пробела
    AskAndReplace(&quot;(?&lt;=[:space:])[:space:]+&quot;,&quot;&quot;)
	&apos;Не должно быть ни одного пробела в начале абзацев
    AskAndReplace(&quot;^[:space:]+&quot;,&quot;&quot;)
    &apos;Не должно быть пустых абзацев
    AskAndReplace(&quot;^$&quot;,&quot;&quot;)

	replaceBaseWithStandard
	
	convertFormattingToText
	
	manualFontsToCharStyle
	
	removeDirectFormatting
	
	convertFormattingFromText
	
	resetFootnotesStyle
	
	removeUnusedStyles

End Sub

Sub manualFontsToCharStyle
	Dim oDoc
	oDoc = Thiscomponent
	Dim srch(0) as new com.sun.star.beans.PropertyValue
	SDesc = Thiscomponent.createSearchDescriptor()
	  SDesc.SearchAll = true
	  SDesc.ValueSearch = false
	  SDesc.SearchStyles = false 
	  SDesc.SearchRegularExpression = false
	  SDesc.SearchString = &quot;&quot; 
	  srch(0).Name = &quot;CharFontName&quot;
	  SDesc.SetSearchAttributes(srch())
	  founds = Thiscomponent.findFirst(SDesc)
	  do while not isNull(founds)
	    curFont = founds.CharFontName
	    If curFont &lt;&gt; &quot;IPH Astra Serif&quot; AND curFont &lt;&gt; &quot;&quot; Then
	      If Not DocHasCharStyle(oDoc,curFont) Then
	        oProps() = Array(CreateProperty(&quot;CharFontName&quot;, curFont))
	        CreateCharacterStyle(curFont, oProps())
	      End If
	      founds.CharStyleNames = Array(curFont)
	    End If
	    founds = Thiscomponent.findNext(founds.getend, SDesc)
	  loop
End Sub

Private Sub replaceBaseWithStandard
	replaceParaStyle(&quot;Базовый&quot;,&quot;Основной текст&quot;)
	replaceParaStyle(&quot;Default Style&quot;,&quot;Text Body&quot;)
End Sub

Private Sub replaceParaStyle(oldStyleName,newStyleName)
	dim document   as Object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dim args1(21) as new com.sun.star.beans.PropertyValue
	args1(0).Name = &quot;SearchItem.StyleFamily&quot;
	args1(0).Value = 2
	args1(1).Name = &quot;SearchItem.CellType&quot;
	args1(1).Value = 0
	args1(2).Name = &quot;SearchItem.RowDirection&quot;
	args1(2).Value = true
	args1(3).Name = &quot;SearchItem.AllTables&quot;
	args1(3).Value = false
	args1(4).Name = &quot;SearchItem.SearchFiltered&quot;
	args1(4).Value = false
	args1(5).Name = &quot;SearchItem.Backward&quot;
	args1(5).Value = false
	args1(6).Name = &quot;SearchItem.Pattern&quot;
	args1(6).Value = true
	args1(7).Name = &quot;SearchItem.Content&quot;
	args1(7).Value = false
	args1(8).Name = &quot;SearchItem.AsianOptions&quot;
	args1(8).Value = false
	args1(9).Name = &quot;SearchItem.AlgorithmType&quot;
	args1(9).Value = 0
	args1(10).Name = &quot;SearchItem.SearchFlags&quot;
	args1(10).Value = 65536
	args1(11).Name = &quot;SearchItem.SearchString&quot;
	args1(11).Value = oldStyleName
	args1(12).Name = &quot;SearchItem.ReplaceString&quot;
	args1(12).Value = newStyleName
	args1(13).Name = &quot;SearchItem.Locale&quot;
	args1(13).Value = 255
	args1(14).Name = &quot;SearchItem.ChangedChars&quot;
	args1(14).Value = 2
	args1(15).Name = &quot;SearchItem.DeletedChars&quot;
	args1(15).Value = 2
	args1(16).Name = &quot;SearchItem.InsertedChars&quot;
	args1(16).Value = 2
	args1(17).Name = &quot;SearchItem.TransliterateFlags&quot;
	args1(17).Value = 1280
	args1(18).Name = &quot;SearchItem.Command&quot;
	args1(18).Value = 3
	args1(19).Name = &quot;SearchItem.SearchFormatted&quot;
	args1(19).Value = false
	args1(20).Name = &quot;SearchItem.AlgorithmType2&quot;
	args1(20).Value = 1
	args1(21).Name = &quot;Quiet&quot;
	args1(21).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:ExecuteSearch&quot;, &quot;&quot;, 0, args1())
End Sub

Private Sub doNotTrack
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	document   = ThisComponent.CurrentController.Frame
	dim trackProperties(0) as new com.sun.star.beans.PropertyValue
	trackProperties(0).Name = &quot;TrackChanges&quot;
	trackProperties(0).Value = false
	dispatcher.executeDispatch(document, &quot;.uno:TrackChanges&quot;, &quot;&quot;, 0, trackProperties())
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = &quot;ShowTrackedChanges&quot;
	args1(0).Value = true
	dispatcher.executeDispatch(document, &quot;.uno:ShowTrackedChanges&quot;, &quot;&quot;, 0, args1())
End Sub



Private Sub removeDirectFormatting
	Dim oDescriptor &apos;The search descriptor
	dim dispatcher as Object
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dim document   as Object
	document   = ThisComponent.CurrentController.Frame
	Dim oViewCursor As Object &apos;View cursor
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
	oViewCursor.gotoStart(false)
	oViewCursor.gotoEnd(true)
	dispatcher.executeDispatch(document, &quot;.uno:ResetAttributes&quot;, &quot;&quot;, 0, Array())
	footNotes = thisComponent.Footnotes
	For x = 0 to footNotes.Count -1
	  aNote = footNotes.getByIndex(x)
	  footNoteText = aNote.getText()
	  oTextcursor = footNoteText.createTextCursor()
	  oViewCursor.gotoRange(oTextcursor.getStart(),false) 
	  oViewCursor.gotoEnd(true)
	  dispatcher.executeDispatch(document, &quot;.uno:ResetAttributes&quot;, &quot;&quot;, 0, Array())
	Next
	endNotes = thisComponent.Endnotes
	for x = 0 to endNotes.Count -1
	  aNote = endNotes.getByIndex(x)
	  endNoteText = aNote.getText()
	  oTextcursor = endNoteText.createTextCursor()
	  oViewCursor.gotoRange(oTextcursor.getStart(),false) 
	  oViewCursor.gotoEnd(true)
	  dispatcher.executeDispatch(document, &quot;.uno:ResetAttributes&quot;, &quot;&quot;, 0, Array())
	next
	
	oViewCursor.gotoStart(false)
End Sub

Private Sub resetFootnotesStyle
	Dim oDescriptor &apos;The search descriptor
	dim dispatcher as Object
	dispatcher = createUnoService(&quot;com.sun.star.frame.DispatchHelper&quot;)
	dim document   as Object
	document   = ThisComponent.CurrentController.Frame
	Dim oViewCursor As Object &apos;View cursor
	oViewCursor = ThisComponent.CurrentController.getViewCursor()
	allNotes= thisComponent.FootNotes
	for x = 0 to allNotes.Count -1
	  aNote = allNotes.getByIndex(x)
	  aNote.Anchor.CharStyleName=&quot;Footnote anchor&quot;
	  oEnum = aNote.Text.createEnumeration()
	  Do While oEnum.hasMoreElements()
	    oCurPar = oEnum.nextElement()
	    oCurPar.ParaStyleName = &quot;Footnote&quot;
	  Loop
	Next
End Sub

Private Sub removeUnusedStyles
	&apos;calls: RemoveUnusedStyles
	Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
	Dim oDoc as object
	oDoc = ThisComponent
	oFamilies = thiscomponent.StyleFamilies
	sElements() = oFamilies.getElementNames()
	For i = 0 to uBound(sElements()) -2
	   oFamily = oFamilies.getByName(sElements(i))
	   removeUnusedStyle(oFamily,sElements(i),True)
	Next
End Sub

Private Sub removeUnusedStyle(oFamily,sFamily as string, bAsk as Boolean)
	&apos;calls: getStyleNames
	Dim sUsed() as String, sMsg$,iAnswer%, bStop as boolean
	sUsed() = getStyleNames(oFamily,bLocalized:=True,bUsed:=False,bUserDef:=true)
	If uBound(sUsed()) &gt; -1 then
	         For i = 0 to uBound(sUsed())
	            oFamily.removeByName(sUsed(i))
	         Next
	EndIf
End Sub

Private Sub convertFormatToEnclosure(identifier, styleNames, styleValues)
	leftEnclosure = compileLeftEnclosure(identifier)
	rightEnclosure = compileRightEnclosure(identifier)
	Dim oTextCursor As Object
	Dim startTextRange As Object
	Dim endTextRange As Object
	Dim foundString As String
	Dim SrchAttributes(Ubound(styleNames)) as new com.sun.star.beans.PropertyValue
	For i = 0 To Ubound(styleNames)
		SrchAttributes(i).Name = styleNames(i)
		SrchAttributes(i).Value = styleValues(i)
	Next i
	SDesc = Thiscomponent.createSearchDescriptor()
	SDesc.SearchAll = true
	SDesc.SearchRegularExpression = true
	SDesc.SearchString = &quot;&quot;
	SDesc.searchStyles = false
	SDesc.SetSearchAttributes(SrchAttributes)
	found = Thiscomponent.findFirst(SDesc)
	  Do While not isNull(found)
	  	oTextCursor = found.Text.createTextCursor()
	  	oTextCursor.goToRange(found.Start, false)
	  	oTextCursor.goToRange(found.End, true)
  		For i = 0 To Ubound(styleNames)
			oTextCursor.setPropertyToDefault(styleNames(i))
		Next i
		foundString = found.getString()
		If Len(foundString) &lt;&gt; 0 Then
			oTextCursor.collapseToEnd()
			oTextCursor.String = rightEnclosure
			endTextRange = oTextCursor.getEnd()
			oTextCursor.goToRange(found.start,false)
			oTextCursor.String = leftEnclosure
		EndIf
		found = Thiscomponent.findNext(found.End, SDesc)
	  Loop
End Sub

Private Sub convertEnclosuresToFormat(identifier, styleNames, styleValues)
	Dim oTextCursor As Object
	Dim startTextRange As Object
	Dim endTextRange As Object
	Dim leftEnclosure As String
	Dim rightEnclosure As String
	leftEnclosure = compileLeftEnclosure(identifier)
	rightEnclosure = compileRightEnclosure(identifier)
	SDesc = Thiscomponent.createSearchDescriptor()
	SDesc.SearchAll = true
	SDesc.SearchRegularExpression = true
	SDesc.SearchString = leftEnclosure + &quot;([^&quot; + identifier+ &quot;]*)&quot; + rightEnclosure

	found = Thiscomponent.findFirst(SDesc)
	  Do While not isNull(found)
	  	oTextCursor = found.Text.createTextCursor()
	  	oTextCursor.goToRange(found.Start, false)
	  	oTextCursor.goToRange(found.End, true)
	  	oTextCursor.setPropertyValues(styleNames, styleValues)
	  	oTextCursor.collapseToEnd()
		oTextCursor.goLeft(Len(rightEnclosure), true)
		oTextCursor.String = &quot;&quot;
		endTextRange = oTextCursor.getEnd()
		oTextCursor.goToRange(found.start,false)
		oTextCursor.goRight(Len(leftEnclosure), true)
		oTextCursor.String = &quot;&quot;
		found = Thiscomponent.findNext(endTextRange, SDesc)
	  Loop
End Sub


Private Function compileSearchString(identifier)
	compileSearchString = &quot;&lt;&quot;+identifier+&quot;&gt;&quot;+&quot;(.*?)&quot;+&quot;&lt;/&quot;+identifier+&quot;&gt;&quot;
End Function

Private Function compileLeftEnclosure(identifier)
	compileLeftEnclosure = &quot;&lt;&quot;+identifier+&quot;&gt;&quot;
End Function

Private Function compileRightEnclosure(identifier)
	compileRightEnclosure = &quot;&lt;/&quot;+identifier+&quot;&gt;&quot;
End Function


Private Sub toTextBold
	styleNames = Array(&quot;CharWeight&quot;)
	styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
	convertFormatToEnclosure(CHR(867), styleNames, styleValues)
End Sub

Private Sub fromTextBold
	styleNames = Array(&quot;CharWeight&quot;)
	styleValues = Array(com.sun.star.awt.FontWeight.BOLD)
	convertEnclosuresToFormat(CHR(867), styleNames, styleValues)
End Sub

Private Sub toTextItalic
	styleNames = Array(&quot;CharPosture&quot;)
	styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
	convertFormatToEnclosure(CHR(868), styleNames, styleValues)
End Sub

Private Sub fromTextItalic
	styleNames = Array(&quot;CharPosture&quot;)
	styleValues = Array(com.sun.star.awt.FontSlant.ITALIC)
	convertEnclosuresToFormat(CHR(868), styleNames, styleValues)
End Sub

Private Sub toTextStrikeout
	styleNames = Array(&quot;CharStrikeout&quot;)
	styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
	convertFormatToEnclosure(CHR(869), styleNames, styleValues)

End Sub

Private Sub fromTextStrikeout
	styleNames = Array(&quot;CharStrikeout&quot;)
	styleValues = Array(com.sun.star.awt.FontStrikeout.SINGLE)
	convertEnclosuresToFormat(CHR(869), styleNames, styleValues)
End Sub


Private Sub toTextUnderline
	styleNames = Array(&quot;CharUnderline&quot;)
	styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
	convertFormatToEnclosure(CHR(870), styleNames, styleValues)
End Sub

Private Sub fromTextUnderline
	styleNames = Array(&quot;CharUnderline&quot;)
	styleValues = Array(com.sun.star.awt.FontUnderline.SINGLE)
	convertEnclosuresToFormat(CHR(870), styleNames, styleValues)
End Sub

Private Sub toTextSuperscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,101)
	convertFormatToEnclosure(CHR(871), styleNames, styleValues)
End Sub

Private Sub fromTextSuperscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,101)
	convertEnclosuresToFormat(CHR(871), styleNames, styleValues)
End Sub

Private Sub toTextSubscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,-101)
	convertFormatToEnclosure(CHR(872), styleNames, styleValues)
End Sub

Private Sub fromTextSubscript
	styleNames = Array(&quot;CharEscapementHeight&quot;,&quot;CharEscapement&quot;)
	styleValues = Array(58,-101)
	convertEnclosuresToFormat(CHR(872), styleNames, styleValues)
End Sub

Private Sub toTextSparce
	styleNames = Array(&quot;CharKerning&quot;)
	For i=70 To 70 
		styleValues = Array(i)
		convertFormatToEnclosure(CHR(873) &amp; i, styleNames, styleValues)
	Next
End Sub

Private Sub fromTextSparce
	styleNames = Array(&quot;CharKerning&quot;)
	For i=70 To 70 
		styleValues = Array(i)
		convertEnclosuresToFormat(CHR(873) &amp; i, styleNames, styleValues)
	Next 
End Sub


Private Sub convertFormattingToText
	toTextBold
	toTextItalic
	toTextStrikeout
	toTextUnderline
	toTextSuperscript
	toTextSubscript
	toTextSparce
End Sub

Private Sub convertFormattingFromText
	fromTextSparce
	fromTextSuperscript
	fromTextSubscript
	fromTextUnderline
	fromTextStrikeout
	fromTextItalic
	fromTextBold
End Sub

Private Function confirm(description)
	If MsgBox (description, 4) =6 Then
		confirm = true
	Else
		confirm = false
	EndIf
	
End Function

Private Sub ReplaceFormatting(SearchString,oReplaceString,SrchAttributes,ReplAttributes, searchStyles)
	Dim oReplace
	oReplace = ThisComponent.createReplaceDescriptor()
	oReplace.SearchString = SearchString
	oReplace.ReplaceString = oReplaceString
	oReplace.SearchRegularExpression=True
	oReplace.SearchCaseSensitive = True
	
	oReplace.searchAll=True
	If Not IsEmpty(SrchAttributes(0).Value) Then
	  oReplace.SetSearchAttributes(SrchAttributes())
	  oReplace.searchStyles = searchStyles
	End If
	If Not IsEmpty(ReplAttributes(0).Value) Then
	  oReplace.SetReplaceAttributes(ReplAttributes())
	End If
	ThisComponent.replaceAll(oReplace)
End Sub

Private Function getStyleNames(oFamily,bLocalized as Boolean, _
	   optional bUsed, optional bUserDef)
	Dim oStyle,i%,sNames$(),sName$,chkUse as Boolean, chkUDef as Boolean
	For i = 0 to oFamily.getCount -1
	   oStyle = oFamily.getByIndex(i)
	   If bLocalized then
	      sName = oStyle.DisplayName
	   Else
	      sName = oStyle.getName
	   Endif
	   If (vartype(bUsed) = 11)then
	      chkUse = (bUsed EQV oStyle.isInUse)
	   Else
	      chkUse = True
	   Endif
	   If (vartype(bUserDef) = 11) then
	      chkUDef = (bUserDef EQV oStyle.isUserDefined)
	   Else
	      chkUDef = True
	   EndIf
	   If sName = &quot;Автор&quot; Or sName = &quot;Автор по-английски&quot; Or sName = &quot;Ключевые слова&quot; Or sName = &quot;Текст списка литературы&quot; Or sName = &quot;Эпиграф&quot; or sName = &quot;Цитирование&quot; or sName = &quot;Сведения об авторе&quot; or sName = &quot;Аннотация&quot; Then
	     chkUse = False
	   Endif
	   If chkUse AND chkUDef then
	      bas_Pusharray sNames(),sName
	   Endif
	Next
	getStyleNames = sNames()
	End Function
	
	&apos;very simple routine appending some element to an array which can be undimensioned (LBound &gt; UBound)
	Sub bas_PushArray(xArray(),vNextElement)
	Dim iUB%,iLB%
	iLB = lBound(xArray())
	iUB = uBound(xArray())
	If iLB &gt; iUB then
	   iUB = iLB
	   redim xArray(iLB To iUB)
	Else
	   iUB = iUB +1
	   redim preserve xArray(iLB To iUB)
	Endif
	xArray(iUB) = vNextElement
End Sub
</script:module>