I succeeded creating Document elements containing externally provided RTF.
Dim art As EA.Element : Set art = parent.Elements.AddNew(nam, "Artifact")
art.Update
art.StereotypeEx = "Document"
art.Version = "1.0"
art.Update
' Add document content
Dim xid As String : xid = CreateGUID()
Dim docname As String : docname = parent.Name & "::" & art.Name
Dim bin As String : bin = PackFile(rtf_file)
Call Repository.Execute("INSERT INTO `t_document` (DocID, DocName, Style, ElementID, ElementType, BinContent, DocType, IsActive, Sequence, DocDate) VALUES ('" & xid & "', '" & docname & "', '', '" & art.ElementGUID & "', 'ModelDocument', X'" & bin & "', 'ModelDocument', '0', '0', '" & Format(Now(), "yyyy-MM-dd hh:mm:ss") & "');")
Function PackFile(ByVal fname As String) As String
If (m_fso.FileExists(fname)) Then
' Copy file to new "%temp%\str.dat"
Dim dstname
dstname = m_fso.BuildPath(m_fso.GetSpecialFolder(2).Path, "str.dat")
Call m_fso.CopyFile(fname, dstname)
Dim zipname
zipname = m_fso.BuildPath(m_fso.GetSpecialFolder(2).Path, "str.zip")
With m_fso.OpenTextFile(zipname, ForWriting, True)
' this is the header to designate a file as a zip
.Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
.Close
End With
With CreateObject("Shell.Application")
Dim dns: Set dns = .Namespace(zipname)
Call dns.CopyHere(dstname, 1024 + 16 + 4)
Dim waitTill: waitTill = Now() + TimeValue("00:00:01")
While Now() < waitTill
DoEvents
Wend
End With
With CreateObject("ADODB.Stream")
.Type = 1 'adTypeBinary
.Open
Call .LoadFromFile(zipname)
Dim node: Set node = CreateObject("MSXML2.DOMDocument").createElement("bin")
node.DataType = "bin.hex"
node.nodeTypedValue = .Read()
PackFile = node.Text
End With
End If
End Function
The RTF is rendered fine (as far as I can say).
But EA doesn't allow changing the content of these Document files.
I'm unable to find the reason for this behavior.
Maybe someone already has come across this problem and could provide some insight?
TIA
Michael
