Run the macro provided. It will extract all graphics from an existing writer document
and place them in a folder "/Pictures" relative to the writer document. All pictures
will be renamed to the internal graphics name and linked to the writer document.
After that the pictures folder inside the "*.sxw" file will be removed.
Place the macro into the "user" application container (e.g. soffice-&Standard-&Module1)
Open the writer document you want "refactor" and run the macro.
Remember: Always try this with a copy of your work !
Don't forget to check if "Save URLs relative to File system" in in Tools ->
Options -> Load/Save -> General is enabled.
OPTION EXPLICIT
Sub ExtractWriterGraphics
On Local Error Goto ErrorHandler
Dim oDocument as Object
Dim oGraphics as Object
Dim oZipArchive as New com.sun.star.packages.Package
Dim oPictures as Object
Dim mZipFile(0) as Variant
Dim mFiles() as String
Dim oFileAccess as New com.sun.star.ucb.SimpleFileAccess
Dim oFile as Object
Dim oInputStream as Object
Dim oOutputStream as Object
Dim mData() as Variant
Dim sDestFolder as String
Dim sGraphicName as String
Dim sGraphicURL as String
Dim sTmp as String
Dim oUrl as New com.sun.star.util.URL
Dim oTransformer as Object
Dim n as Long
Dim i as Integer
Dim j as Integer
Dim k as Integer
oDocument = StarDesktop.getCurrentComponent
' create destination folder relative to document ...
oTransformer = createUnoService("com.sun.star.util.URLTransformer")
oUrl.Complete = oDocument.URL
oTransformer.parsestrict(oUrl)
sDestfolder = "file://" & oURL.Path & "Pictures/"
' open zip file and get content of "Pictures" folder ...
oZipArchive = createUnoService("com.sun.star.packages.Package")
mZipFile(0) = oDocument.URL
oZipArchive.initialize(mZipFile())
oPictures = oZipArchive.getByHierarchicalName("Pictures")
oGraphics = oDocument.getGraphicObjects
' for all pictures in document ...
For i = 0 to oGraphics.getCount-1
mFiles() = oPictures.getElementNames
sGraphicURL = oGraphics.getByIndex(i).GraphicURL
sTmp = sGraphicURL
' internal picture names start with "vnd.sun..."
If InStr(1, sGraphicURL, "vnd.sun.star.GraphicObject:", 0) = 1 Then
' get the picture name (comes without the extension)
sGraphicURL = Mid(sGraphicURL, 28, Len(sGraphicURL))
' so search all files in pictures folder for the current picture ...
For j = 0 to uBound(mFiles())
If InStr(1, mFiles(j), sGraphicURL, 0) Then
' create new name with extension ...
sGraphicName = oGraphics.getByIndex(i).getName() & Mid(mFiles(j), Len(sGraphicURL)+1, Len(mFiles(j))
Exit For
EndIf
Next j
' copy file to external folder relative to stored document...
oFileAccess = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oFile = oFileAccess.openFileWrite(sDestFolder & sGraphicName)
oOutputStream = createUnoService("com.sun.star.io.DataOutputStream")
oOutputStream.setOutputStream(oFile)
oInputStream = oPictures.getByName(mFiles(j)).getInputStream()
n = -1
While n <> 0
n = oInputStream.readBytes(mData(), 16384)
oOutputStream.writeBytes(mData())
Wend
oOutputStream.flush()
oOutputStream.closeOutput()
oInputStream.closeInput()
ReDim mData() as Variant
' now link picture to new external file ...
oGraphics.getByIndex(i).GraphicURL = sDestFolder & sGraphicName
' check for duplicates, link them too ...
For k = i + 1 to oGraphics.getCount-1
If sTmp = oGraphics.getByIndex(k).GraphicURL Then
oGraphics.getByIndex(k).GraphicURL = sDestFolder & sGraphicName
EndIf
Next k
EndIf
Next i
' this automatically removes the unused internal pictures too :-)
oDocument.store()
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err() & " " & Error() & " " & Erl()
End Sub