Word: Via OLE Automation RTF einfügen

[Remko]

Maybe the code below helps you, it's a snippet from one of my old programs.
ReadFromWord takes an active word document as input var and outputs the document's contents as RTF text. WriteToWord goes the other way round.

Delphi-Quellcode:

function TForm1.ReadFromWord(Doc: _Document): PChar;
var DataObject: IDataObject;
    ReturnData: TStgMedium;
    RTFFormat: TFormatEtc;

    begin
  if Assigned(Doc) then begin
    try
      if Doc.QueryInterface(IDataObject, DataObject) = 0 then begin
        cfRTF := RegisterClipboardFormat('Rich Text Format');
        RTFFormat.cfFormat := CFRTF;
        RTFFormat.tymed := TYMED_HGLOBAL;
        RTFFormat.ptd := nil;
        RTFFormat.dwAspect := DVASPECT_CONTENT;
        RTFFormat.lindex := -1;
        OleCheck(DataObject.GetData(RTFFormat, ReturnData));
        ReadFromWord := GlobalLock(ReturnData.hglobal);
        GlobalUnlock(ReturnData.hglobal);
      end
      else begin
        ShowMessage('QueryInterface failed');
      end;
    except
      ShowMessage('Error while getting RTF');
    end;
  end;
end;

procedure TForm1.WriteToMSWord(WordDoc: _Document; const RTFText: String);
var
  cfRTF: Integer;
  DataObj : IDataObject;
  RTFFormat: TFormatEtc;
  Medium : TStgMedium;
  pGlobal : Pointer;

begin
    OleCheck(WordDoc.QueryInterface(IDataObject,DataObj));
    cfRTF := RegisterClipboardFormat('Rich Text Format');
    RTFFormat.cfFormat := CFRTF;
    RTFFormat.tymed := TYMED_HGLOBAL;
    RTFFormat.ptd := nil;
    RTFFormat.dwAspect := DVASPECT_CONTENT;
    RTFFormat.lindex := -1;
    FillChar(Medium,SizeOf(Medium),0);
    Medium.tymed := RTFFormat.tymed;
    Medium.hGlobal := GlobalAlloc(GMEM_MOVEABLE, Length(RTFText)+1);
    try
     pGlobal := GlobalLock(Medium.hGlobal);
     CopyMemory(PGlobal,PChar(RTFText),Length(RTFText)+1);
     GlobalUnlock(Medium.hGlobal);
     OleCheck(DataOBJ.SetData(RTFFormat,Medium,True));
    finally
      GlobalFree(Medium.hGlobal);
      ReleaseStgMedium(Medium);
    end;
end;