Hi Heiko,
following code works for me to create a new zip archive and add a file
Regards
Oliver
OPTION EXPLICIT
Sub Test()
Dim oZipArchive as Variant
Dim aArg As New com.sun.star.beans.NamedValue
Dim SURL as String
Dim sFile as String
sURL = ConvertToURL("D:\TEMP\")
oZipArchive = createUnoService("com.sun.star.packages.Package")
aArg.Name = "PackageFormat"
aArg.Value = True
oZipArchive.initialize(Array(sURL & "test.zip", aArg))
sFile = "test.txt"
Call AddFiletoZipArchive(oZipArchive, sURL, sFile)
End Sub
Sub AddFiletoZipArchive(oZipArchive as Object, ByVal sUrl as String, ByVal sFile as String)
On Local Error Goto ErrorHandler
Dim oSimpleFileAccess as Object
Dim oInputStream as Object
Dim oStream as Object
Dim oPosition as Object
Dim mArgs(0) as Variant
mArgs(0) = False
oStream = oZipArchive.createInstanceWithArguments(mArgs())
oSimpleFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
oInputStream = oSimpleFileAccess.openFileRead(sURL & sFile)
oStream.setInputStream(oInputStream)
oPosition = oZipArchive.getByHierarchicalName("")
oPosition.insertByName(sFile, oStream)
oZipArchive.commitChanges()
oInputStream.closeInput()
Exit Sub
ErrorHandler:
MsgBox Err() & " - " & Error() & " - Row: " & Erl()
End Sub
Context
Privacy Policy |
Impressum (Legal Info) |
Copyright information: Unless otherwise specified, all text and images
on this website are licensed under the
Creative Commons Attribution-Share Alike 3.0 License.
This does not include the source code of LibreOffice, which is
licensed under the Mozilla Public License (
MPLv2).
"LibreOffice" and "The Document Foundation" are
registered trademarks of their corresponding registered owners or are
in actual use as trademarks in one or more countries. Their respective
logos and icons are also subject to international copyright laws. Use
thereof is explained in our
trademark policy.