in vba there is no PropertyBag class
I try to write a tlb to use PropertyBag, it succeed
save these txt to PropertyBag.odl
and then compile odl to tlb
cmd command as follow:
mktyplib.exe /tlb PropertyBag.tlb PropertyBag.odl
and then u can use class PropertyBag in VBA now.
Code:
[
uuid(EA544A21-C82D-11D1-A3E4-00A0C90ABCDE),
version(1.0),
helpstring("VBA PropertyBag"),
helpfile("VB98.CHM"),
helpcontext(0x000df908)
]
library VBRUN
{
// TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
importlib("stdole2.tlb");
// Forward declare all types defined in this typelib
interface _PropertyBag;
[
odl,
uuid(4495AD01-C993-11D1-A3E4-00A0C90AEA82),
helpstring("A PropertyBag object holds information that is to be persisted across invocations of a control."),
helpcontext(0x000df639),
hidden,
dual,
nonextensible,
oleautomation
]
interface _PropertyBag : IDispatch {
[id(0x00000001), helpstring("Returns a persisted value from a PropertyBag class object."), helpcontext(0x000df63a)]
HRESULT ReadProperty(
[in] BSTR Name,
[in, optional] VARIANT DefaultValue,
[out, retval] VARIANT* Value);
[id(0x00000002), helpstring("Writes a value to be persisted to a PropertyBag class object."), helpcontext(0x000df63b)]
HRESULT WriteProperty(
[in] BSTR Name,
[in] VARIANT Value,
[in, optional] VARIANT DefaultValue);
[id(0x00000003), propget, helpstring("A byte array representing the contents of the PropertyBag"), helpcontext(0x000df973)]
HRESULT Contents([out, retval] VARIANT* retval);
[id(0x00000003), propput, helpstring("A byte array representing the contents of the PropertyBag"), helpcontext(0x000df973)]
HRESULT Contents([in] VARIANT retval);
};
[
uuid(D5DE8D20-5BB8-11D1-A1E3-00A0C90F2731),
helpstring("A PropertyBag object holds information that is to be persisted across invocations of a control."),
helpcontext(0x000df639)
]
coclass PropertyBag {
[default] interface _PropertyBag;
};
};
a function to save object to string
Code:
Function ObjectSaveToString(objSource As Object, KeyName As String) As String
Dim i As Long
Dim objBag As New PropertyBag
Dim bytData() As Byte
On Error Resume Next
If objSource Is Nothing Or Len(KeyName) = 0 Then Exit Function
objBag.WriteProperty KeyName, objSource
bytData = objBag.Contents
For i = 0 To UBound(bytData)
ObjectSaveToString = ObjectSaveToString & IIf(bytData(i) < 16, "0", "") & Hex(bytData(i))
Next
End Function