AutoCorrect import macro? 2008 version
Posted: Mon Jun 30, 2008 10:39 pm
Orijinal topic is here; http://www.oooforum.org/forum/viewtopic ... highlight= code created by patb and Zarius Thanks
At this point we need, adress http://word.mvps.org/FAQs/Customization ... orrect.htm instructions from this site download Autocorrect.zip, with autocorrect.dot create word backup copy autocorrect list document.
I tested in Pardus(Linux), WindowsXP OOo2.4.X
With this file click the import button with macro opens, file open dialog select word backup document . Done. File has using instructions in English and Turkish.
I made some code modifications;
* Calc section, cut, copy, paste sections canceled. No more file operations.
* Now detectlocale function converts two byte locale strings to five bytes correct forms. Such as fr, tr to fr-FR, tr-TR
* File picker dialog added for selection backup word file
* If user hasn't acor_xx-xx.dat in user path macro copies it from OOo share path.
* İf writer has same autocorrect entries like word These entries doesn't insert to writer.
Here is the whole code;
Sincerely,
At this point we need, adress http://word.mvps.org/FAQs/Customization ... orrect.htm instructions from this site download Autocorrect.zip, with autocorrect.dot create word backup copy autocorrect list document.
I tested in Pardus(Linux), WindowsXP OOo2.4.X
With this file click the import button with macro opens, file open dialog select word backup document . Done. File has using instructions in English and Turkish.
I made some code modifications;
* Calc section, cut, copy, paste sections canceled. No more file operations.
* Now detectlocale function converts two byte locale strings to five bytes correct forms. Such as fr, tr to fr-FR, tr-TR
* File picker dialog added for selection backup word file
* If user hasn't acor_xx-xx.dat in user path macro copies it from OOo share path.
* İf writer has same autocorrect entries like word These entries doesn't insert to writer.
Here is the whole code;
Code: Select all
REM ***** BASIC *****
global gWriterDoc as object
global autoCorrDbDatFileWithPath as string
global autoCorrDbDatFile
global autoCorrFileXmlWithPath as string
global ilke as variant
sub ImportACLFromWord
GlobalScope.BasicLibraries.LoadLibrary("Tools")
' ImportACLfromWord - 23/06/2006 by Pat B
' Modifications 25/06/2006 by Zarius (refactored & generalised)
' Modifications 29/06/2008 by Ramdem
'I made some code modifications;
'* Calc section, cut, copy, paste sections canceled. No more file operations.
'* Now detectlocale function converts two byte locale strings to five bytes correct forms. Such as fr, tr to fr-FR, tr-TR
'* File picker dialog added for selection backup word file
'* If user hasn't acor_xx-xx.dat in user path macro copies it from OOo share path.
' ** Back up your //.openoffice.org2/user/autocorr/acor_xx-xx.dat before you start.
' Use MS Word to back up your Word autocorrect list using the macro at
' http://word.mvps.org/FAQs/Customization/ExportAutocorrect.htm
' Then open that document in Writer, run this macro then restart OpenOffice.
' Before running, uncomment the appropriate version below and
' replace the locale (OO1.x: 1033, OO2.x: en-AU) with your locale.
' New: the macro should automatically detect the locale on OO2.x
' **********************************************************************
' ******************** EDIT ME *****************************************
' SO7/OO1.x
'locale = "1033" ' SO7, OO1.x - other locales have different numbers (eg 1031)
'autoCorrDbDatFile = "acor"+locale+".dat" ' this probably wont change
' OO2.x
'locale = "tr-TR" en-AU = Australian English (change to your own locale)
locale = detectLocale()
autoCorrDbDatFile = "acor_"+locale+".dat" ' this probably wont change
' ******************** END: EDIT ME ************************************
' **********************************************************************
' The macro selects the unformatted entries (ie RTF='False' elements) in MS
' Word's AutoCorrect Backup Document and transposes these to a text document
' called DocumentList.xml which is then zipped into
' //.openoffice.org2/user/autocorr/acor_en-AU.dat.
' It does not transpose formatted entries. I suggest you do this manually.
' Good luck! No Warranty!
dim msg as string
sotoduzeltyolu = ConvertToURL(PickFileName())
gWriterDoc = StarDesktop.loadComponentFromURL( sotoduzeltyolu , "_blank", 0, Array() )
autoCorrFileXml = "DocumentList.xml" ' this probably wont change
' setup the path and filenames for the AutoCorrect database and the xml file
oPaths = CreateUnoService( "com.sun.star.util.PathSettings" )
toplamstring = oPaths.AutoCorrect
ilke() = split(toplamstring,";") 'find autocorrect paths first share and second user
sofficeConfigPath = ConvertFromURL(ilke(1)) ' strip the file:/// from the front
autoCorrDbDatFileWithPath = ilke(1) + "/" + autoCorrDbDatFile
autoCorrFileXmlWithPath = ilke(1) + "/" + autoCorrFileXml
' ---------------- writer section
' get the rows and columns of the table,
oTables = gWriterDoc.getTextTables()
oTable = oTables.getByIndex(0) 'Select first table(named Table1,Tabelle1 etc)
oRows = oTable.getRows()
oColumns = oTable.getColumns()
if not (oColumns.Count= 3) then
msg = "You don't seem to be in a table. " & _
chr(10) & "The open document should be the AutoCorrect Backup Document " & _
chr(10) & " created by MS Word" & _
chr(10) & "The macro may need tweaking." & _
chr(10) & "Aborting......"
msgbox ( msg, 0, "ERROR!")
exit sub
endif
' replace special characters with their appropriate xml representations
searchArray = array(chr(38), chr(34), chr(60), chr(62), chr(39), "==>")
replaceArray = array("&", """, "<" , ">" , "'", "'==>")
searchAndReplaceArrays(gWriterDoc, searchArray(), replaceArray())
' if not exists acor_xx-xx.dat copy it from share path to user path
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
if (not(oUcb.Exists(autoCorrDbDatFileWithPath))) then
kaynak=ilke(0)+"/"+ autoCorrDbDatFile
hedef=ilke(1) +"/"+ autoCorrDbDatFile
oUcb.copy( kaynak , hedef )
endif
' unzip the document.xml out of the auto correct db file
unzipAutoCorrDB()
' open DocumentList.xml with writer
Dim oMediaDescriptor(1) as new com.sun.star.beans.PropertyValue
oMediaDescriptor(0).name = "FilterName"
oMediaDescriptor(0).value = "Text (encoded)"
oMediaDescriptor(1).name = "FilterOptions"
oMediaDescriptor(1).value = "UTF8"
oOoAcWriterDoc = StarDesktop.loadComponentFromURL( autoCorrFileXmlWithPath, "_blank", 0, oMediaDescriptor() )
' sdesc for discover writer has same autocorrect entry with word
sdesc=oOoAcWriterDoc.createSearchDescriptor
' rdesc for replacing writer entries with word entries
rdesc=oOoAcWriterDoc.createReplaceDescriptor
rdesc.SearchRegularExpression=False
s1=" <block-list:block block-list:abbreviated-name="""
s2=""" block-list:name="""
s3="""/>"
s4="</block-list:block-list>"
' if gui is windows add chr$(10) to string
if getguitype() = 1 then s4=s4+CHR$(10)
' loop through all rows and writer has no entries like word add this entriesr
' (note: a for loop seems easier, but didn't work well due to a shrinking row count)
rowCount = oRows.Count
p = 1
while (p < rowCount)
cellName = "C"+trim(str(p+1))
cellLeftVal = oTable.getCellByName("A"+trim(str(p+1))).String
if(oTable.getCellByName(cellName).String = "True") then goto nothing 'ignore row
sdesc.Searchstring=cellLeftVal
if Not IsNull (oOoAcWriterDoc.FindFirst(sdesc))then goto nothing ' same entry ignore row
' yes we can insert this entry row
cellLeftVal2 = oTable.getCellByName("B"+trim(str(p+1))).String
rdesc.Searchstring=s4
rdesc.Replacestring=s1++cellLeftVal+s2+cellLeftVal2+s3+CHR$(10)+s4
oOoAcWriterDoc.ReplaceAll(rdesc)
nothing:
p = p+1
wend
oOoAcWriterDoc.Store() ' save documentlist.xml
oOoAcWriterDoc.close(true) 'close it
zipAutoCorrDB() 'Save Documentlist.xml to acor_XX-xx.dat.
gWriterDoc.close(true)
if locale="tr-TR" then
msgbox "Otodüzeltme kayıtlarınız Openoffice'e başarıyla alındı. Değişiklikleri görmek için OOo'yu yeniden başlatın.", 0, "Başarıldı."
else
msgbox "Successfully merged the word ac list with OpenOffice. You will need to restart OpenOffice to see the changes.", 0, "Success."
End if
end sub
' This function will search through the document and replace anything in the
' document that matches entries in the searchArray with the relevant
' entry in the replaceArray.
function searchAndReplaceArrays(oDocument, sArray, rArray)
dim oReplace as object
oReplace = oDocument.createReplaceDescriptor()
oReplace.SearchCaseSensitive = True
For p = LBound(sArray()) To UBound(sArray())
oReplace.SearchString = sArray(p)
oReplace.ReplaceString = rArray(p)
oDocument.ReplaceAll(oReplace)
Next p
end function
' thanks to al_andreas for the original zip and unzip autocorrdb functions
sub zipAutoCorrDB()
dim zipService as variant
dim filestreamService as variant
dim inputStream as variant
dim theZipper as variant
dim outputStream as variant
Dim args1(0)
args1(0) = autoCorrDbDatFileWithPath
filestreamService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
inputStream = FilestreamService.OpenFileRead(autoCorrFileXmlWithPath)
zipService = createUnoService("com.sun.star.packages.Package")
zipService.initialize(args1())
theZipper=zipService.createInstance()
theZipper.SetInputStream(inputStream)
autoCorrFileXml = FileNameoutofPath(autoCorrFileXmlWithPath)
outputStream=zipService.getByHierarchicalName("")
outputStream.replaceByName(autoCorrFileXml, theZipper)
zipService.commitChanges()
kill autoCorrFileXmlWithPath
end sub
' thanks to al_andreas for the original zip and unzip autocorrdb functions
sub unzipAutoCorrDB()
dim zipService as variant
dim filestreamService as variant
dim inputStream as variant
dim theZipper as variant
dim outputStream as variant
dim autoCorrFileXml as string
dim args1(0)
args1(0) = autoCorrDbDatFileWithPath
zipService = createUnoService("com.sun.star.packages.Package")
zipService.initialize(args1())
autoCorrFileXml = FileNameoutofPath(autoCorrFileXmlWithPath)
theZipper = ZipService.getByHierarchicalName(autoCorrFileXml)
inputStream = TheZipper.getInputStream()
outputStream = createUnoService("com.sun.star.ucb.SimpleFileAccess")
outputStream.WriteFile(autoCorrFileXmlWithPath, inputStream)
End Sub
function detectLocale() as string
Dim OOLangue as string
Dim aSettings, aConfigProvider
Dim aParams2(0) As new com.sun.star.beans.PropertyValue
aConfigProvider = createUnoService( _
"com.sun.star.configuration.ConfigurationProvider" )
aParams2(0).Name = "nodepath"
aParams2(0).Value = "/org.openoffice.Setup/L10N"
aSettings = _
aConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aParams2() )
OOLangue= aSettings.getbyname("ooLocale")
' if only two bytes long convert to xx-XX form such tr-TR, fr-FR
if len (OOLangue) = 2 then OOlangue = OOlangue +"-"+Ucase(OOlangue)
detectLocale() = OOLangue
end function
Function PickFileName()
oFilePickerDlg = createUnoService( "com.sun.star.ui.dialogs.FilePicker" )
oOfficeFilePickerDlg = createUnoService( "com.sun.star.ui.dialogs.OfficeFilePicker" )
' Unnecessary, the dialog defaults to having multi-select turned off.
' oFilePickerDlg.setMultiSelectionMode( False )
if not isnull ( oFilePickerDlg) and getguitype() = 1 then
oFilePickerDlg.execute()
oFiles = oFilePickerDlg.getFiles()
else
oOfficeFilePickerDlg.execute()
oFiles = oOfficeFilePickerDlg.getFiles()
End if
' Get an array of the files that the user picked.
' There is only one item in the array since we did not
' turn on the Multi-Selection feature of the dialog box.
If UBound( oFiles ) - LBound( oFiles ) + 1 > 0 Then
PickFileName() = ConvertFromURL( oFiles(0) )
Else
PickFileName() = ""
EndIf
End Function