Thanks a lot for your code snippet and the heads-up. It's almost the same code, and after double-checking the minor differences with no success the issue must have been caused by something else. That brought me to the slash in the filename. And eventually it works now like a charm. On 03/19/2017 09:32 AM, Oliver Brinzing wrote:
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
_______________________________________________
LibreOffice mailing list
LibreOffice@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice
-- Dr. Heiko Tietze UX Designer Tel. +49 (0)179/1268509
Attachment:
signature.asc
Description: OpenPGP digital signature