SaveToContainer Method

' Reference to Microsoft CDO for Exchange 2000 Library
' Reference to Microsoft ActiveX Data Objects 2.5 Library

Sub SaveEmbeddedPartsToFolder(iMsg As CDO.message, Url As String)

    Dim iMsgB As New CDO.message
    Dim iDsrcB As CDO.IDataSource
    Dim iFldr As New Folder
    Dim iDsrcFldr As CDO.IDataSource
    Dim Conn As New ADODB.Connection
    Dim iBp As IBodyPart
    Dim iBps As IBodyParts
    Dim ContType As String

    Conn.Provider = "ExOLEDB.DataSource"
    Conn.Open Url

    Set iDsrcFldr = iFldr
    iDsrcFldr.Open Url, Conn

    Set iDsrcB = iMsgB

    Set iBp = iMsg
    Set iBps = iBp.BodyParts

    For Each iBp In iBps
        ContType = iBp.ContentMediaType
        If ContType = "message/rfc822" Then

            iDsrcB.OpenObject iBp, "IBodyPart"
            iDsrcB.SaveToContainer Url, Conn, adModeReadWrite, adCreateOverwrite
            Debug.Print "Saved message has URL " & iDsrcB.SourceURL

        ElseIf ContType = "application/octet-stream" Or _
                    ContType = "application/x-msdownload" Then

            Dim iItem As New Item
            Dim Flds As ADODB.Fields
            Dim Fld As ADODB.Field
            Dim Stm1 As Stream
            Dim Stm2 As Stream

            Set Stm1 = iItem.GetStream

            ' Get Decoded BodyPart stream
            Set Stm2 = iBp.GetDecodedContentStream
            ' Copy bodypart stream to resource stream
            Stm2.CopyTo Stm1

            ' Commit
            Stm1.Flush
            Stm1.Close
            iItem.DataSource.SaveToContainer Url, Conn, adModeReadWrite

        End If
    Next iBp
End Sub
' Reference to Microsoft CDO for Exchange 2000 Library
' Reference to Microsoft ActiveX Data Objects 2.5 Library

Function CreateAndSaveMessageToContainer(Url1 As String) As CDO.message

    Dim iDsrc As CDO.IDataSource
    Dim Conn As New ADODB.Connection
    Conn.Provider = "ExOLEDB.DataSource"
    Conn.Open Url1

    Dim iMsg As New CDO.message

    With iMsg
        .To = "someone@microsoft.com"
        .From = "another@microsoft.com"
        .Subject = "Here is the subject"
        .TextBody = "Here is the text of the message"
    End With

    Set iDsrc = iMsg

    iDsrc.SaveToContainer Url1, _
                Conn, _
                adModeReadWrite

    Set CreateAndSaveMessageToContainer = iMsg

End Function



/*
 You must have the following paths in your
 INCLUDE path.
 %CommonProgramFiles%\system\ado
 %CommonProgramFiles%\microsoft shared\cdo

*/
#ifndef _CORE_EXAMPLE_HEADERS_INCLUDED
#define _CORE_EXAMPLE_HEADERS_INCLUDED
#import <msado15.dll> no_namespace
#import <cdoex.dll> no_namespace
#include <iostream.h>
#endif

void SaveMessageToFolder2(IMessagePtr pMsg, bstr_t url) {

   _ConnectionPtr pConn(__uuidof(Connection));

   if(pMsg == NULL)
      throw _com_error(E_INVALIDARG);
   // for passing optional variants, we may need this
   _variant_t varOpt(DISP_E_PARAMNOTFOUND,VT_ERROR);
   IDataSourcePtr pDsrc = pMsg;

   pConn->Provider = "ExOLEDB.DataSource";
   try {
      pConn->Open(url,bstr_t(),bstr_t(),-1);
   }
   catch(_com_error e) {
      throw e;
   }

   try {
      pDsrc->SaveToContainer(
            url,
            variant_t((IDispatch*)pConn,true), //Connection from Folder bind above
            adModeReadWrite,
            adCreateNonCollection,
            (RecordOpenOptionsEnum) NULL,
            bstr_t(),
            bstr_t()
            );
   }
   catch(_com_error e) {
      cerr << "Error saving message to folder!" << endl;
      throw e;
   }
}


<job id="idatasource_savetocontainer">
<reference object="adodb.record"/>
<reference object="cdo.message"/>
<script language="vbscript">

    Dim iDsrc
    Dim iMsg
    Dim Conn
    Dim InfoNT
    Dim Info
    Dim sFolderUrl

    Set Info   = CreateObject("ADSystemInfo")
    Set InfoNT = CreateObject("WinNTSystemInfo")
    Set Conn   = CreateObject("ADODB.Connection")
    Set iMsg   = CreateObject("CDO.Message")

    sFolderUrl = "http://" & InfoNt.ComputerName & "." & Info.DomainDNSName &  _
           "/public/test_folder/"

    Conn.Provider = "ExOLEDB.DataSource"
    Conn.Open sFolderUrl

    ' ...

    With iMsg
        .To   = "someone@microsoft.com"
        .From = "another@microsoft.com"
        .Subject = "Here is the subject"
        .TextBody = "Here is the text of the message"
    End With

    Set iDsrc = iMsg.DataSource
    iDsrc.SaveToContainer sFolderUrl, Conn
    Wscript.Echo "Saved To and bound to item at URL: " & iDsrc.SourceURL

    iMsg.TextBody = iMsg.TextBody & vbCrLf & "And this is another line."
    iDsrc.Save

</script>
</job>