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
signature.asc
Description: OpenPGP digital signature
_______________________________________________ LibreOffice mailing list LibreOffice@lists.freedesktop.org https://lists.freedesktop.org/mailman/listinfo/libreoffice
