Захотелось мне недавно экспортировать адресную книгу из OperaMail хотя бы в файл формата .csv (простенькую таблицу). Но оказалось, что из самой программы экспортировать её можно только в родной формат-файл contacts.adr. Порывшись на просторах интернета, к сожалению, нашёл только онлайн-конверторы, представляющие собой скрипт на perl (который можно сохранить и выполнить локально). Пользоваться онлайн-услугой не захотелось, как и ставить perl. А так как на тот момент я решил немного почитать про OpenOffice BASIC, то захотелось попробовать написать простой макрос, который открывает файл с адресной книгой формата OperaMail и импортирует её в таблицу активного листа в открытой книги OpenOffice Calc, которую уже можно обработать и сохранить как csv, для последующего импорта в другие почтовые клиенты.
Если кому пригодится, то хорошо. Если нет, то сильно не ругайтесь из-за простыни.
P.S.
1) Можно было бы использовать более простую функцию чтения из файла, но в windows она упорно читала данные, считая, что они в кодировке cp1251 (не знаю почему).
2) Порядок полей и их позиция в таблице заданы явно потому, что не каждая запись в адресной книге имеет все эти поля, поэтому если они не встречаются, то ячейка в получившейся таблице должна остаться пустой.
3) Никаких диалоговых окон для выбора файла макрос не создаёт. Путь к файлу contacts.adr задаётся в переменной «FileName»
3) При запуске макроса открывается диалоговое окно выбора файла.
4) За счёт введения массива сократил «простыню» отвечающую за парсинг и запись данных в лист книги (надеюсь, что перед идентификатором в исходном файле адресной книги будет не больше одного символа табуляции).
REM *** OpenOffice Basic macros for converting OperaMail AddressBook (file "contacts.adr")
REM *** to current OpenOffice Calc Sheet using UTF-8 codepage.
REM *** After launching macros you need to choose "contacts.adr"
REM *** in appearing OpenFIle Dialog window amd press OK/Open
Sub AddrBookConv_utf
' Variables for reading from file
Dim CurrentLine as String
DIm Buf as String
Dim FileName as String
Dim encoding as string
Dim i, j as Integer
' AddressBook record items
Dim AddrBookItem(13) As String
AddrBookItem = Array("ID", "NAME", "URL", "CREATED", "DESCRIPTION", "SHORT NAME", "ACTIVE", _
"MAIL", "PHONE", "FAX", "POSTALADDRESS", "PICTUREURL", "ICON", "M2INDEXID")
' symbol _ is using here for string wraping in openoffice basic code
' Variables for writing current Calc Sheet
Dim oDocument as object
Dim sContent as String
Dim oSheet as object
oDocument = ThisComponent
oSheet = oDocument.CurrentController.getActiveSheet()
' Open file
Filename = ""
FileName = ConvertFromUrl(fOpenFile())
' Checking that FIle was chosen and filename string is not empty now
' before start converting.
If Filename <> "" Then
' Writing AddressBook Item's Names (Column Names)
i = 0
For j = 0 To 13
oSheet.getCellByPosition(j,0).Formula = AddrBookItem(j)
Next j
' Opening file to read in UTF-8
encoding = "UTF-8" ' кодировка входного файла
' names of codepage are described here:
' http://www.iana.org/assignments/character-sets/character-sets.xhtml
fileaccess = createUnoService ("com.sun.star.ucb.SimpleFileAccess")
intextstream = createUnoService ("com.sun.star.io.TextInputStream")
intextstream.setEncoding( encoding )
intext = fileaccess.openFileRead( FileName )
intextstream.setInputStream( intext )
' Check of reaching of the End of File
Do While not intextstream.isEOF
' Reading line from File and parsing
CurrentLine = intextstream.readLine
If CurrentLine <> "" then
SplitStringPar(CurrentLine, Buf)
If InStr(Buf, AddrBookItem(0)) = 1 Then
i = i + 1
End if
For j = 0 To 13
If InStr(Buf, AddrBookItem(j)) = 1 Then
SplitString(CurrentLine, Buf)
oSheet.getCellByPosition(j,i).Formula = Buf
End if
Next j
End if
Loop
' closing file
intextstream.closeInput()
End if
End Sub
REM *** Removing part of string before delimiter "="
Sub SplitString(InputStr as String, OutputStr as String)
Dim DelimStr as String ' delimiter
Dim DelimPos as Integer ' position of delimiter
Dim StrLen As Integer ' length of string
DelimStr = "="
StrLen = Len(InputStr)
DelPos = InStr(InputStr, DelimStr)
' Removing string before delimeter
OutputStr = Mid(InputStr, DelPos+1, StrLen-DelPos+1)
End Sub
REM *** Removing part of string after delimiter "=" and initial tabulation symbol
Sub SplitStringPar(InputStr as String, OutputStr as String)
Dim DelimStr as String ' delimiter
Dim DelimPos as Integer ' position of delimiter
Dim StrLen As Integer ' length of string
DelimStr = "="
StrLen = Len(InputStr)
DelPos = InStr(InputStr, DelimStr)
' Removing string after delimiter
OutputStr = Trim(Mid(InputStr, 1, DelPos-1))
' Removing initial tabulation symbol
StrLen = Len(OutputStr)
DelimStr = Chr(9) ' tabulation symbol
DelPos = InStr(OutputStr, DelimStr)
OutputStr = Mid(OutputStr, DelPos+1, StrLen-DelPos+1)
End Sub
REM *** Opens a Open File Dialog to allow the end user to select a file to import into the program.
REM *** This code is from Andrew Pitonyak's free Useful Macros book
Function fOpenFile() as String
Dim oFileDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim InitPath as String
Dim oUcb as object
Dim filterNames(2) as String
filterNames(0) = "*.adr"
filterNames(1) = "*.*"
GlobalScope.BasicLibraries.LoadLibrary("Tools")
'Note: The following services must be called in the following order,
' otherwise the FileDialog Service is not removed.
oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
AddFiltersToDialog(FilterNames(), oFileDialog)
'Set your initial path here!
InitPath = ConvertToUrl("~")
If oUcb.Exists(InitPath) Then
oFileDialog.SetDisplayDirectory(InitPath)
End If
iAccept = oFileDialog.Execute()
If iAccept = 1 Then
sPath = oFileDialog.Files(0)
fOpenFile = sPath
End If
oFileDialog.Dispose()
End Function
