Как отследить открытие и закрытие документов в приложении Microsoft Word

...
public
  { Public declarations }
  FWordApp: _Application;
  FWordDoc: _Document;
  FWordSink: TWordConnection;
...

procedure StartWordConnection(WordApp: _Application;
  WordDoc: _Document;
  var WordSink: TWordConnection);
var
  PointContainer: IConnectionPointContainer;
  Point: IConnectionPoint;
begin
  try
    // TWordConnection is the COM object which receives the
    // notifications from Word. Make sure to free WordSink when
    // you are done with it.
    WordSink := TWordConnection.Create;
    WordSink.WordApp := WordApp;
    WordSink.WordDoc := WordDoc;

    // Sink with a Word application
    OleCheck(WordApp.QueryInterface(IConnectionPointContainer, PointContainer));
    if Assigned(PointContainer) then
    begin
      OleCheck(PointContainer.FindConnectionPoint(ApplicationEvents, Point));
      if Assigned(Point) then
        Point.Advise((WordSink as IUnknown), WordSink.AppCookie);
    end;

    // Sink with a Word document advise
    OleCheck(WordDoc.QueryInterface(IConnectionPointContainer, PointContainer));
    if Assigned(PointContainer) then
    begin
      OleCheck(PointContainer.FindConnectionPoint(DocumentEvents, Point));
      if Assigned(Point) then
        Point.Advise((WordSink as IUnknown), WordSink.DocCookie);
    end;

  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

procedure TmainForm.btnStartClick(Sender: TObject);
begin
  FWordApp := CoApplication_.Create;
  FWordDoc := FWordApp.Documents.Add(EmptyParam, EmptyParam);
  FWordApp.Visible := True;
  StartWordConnection(FWordApp, FWordDoc, FWordSink);
end;

procedure TmainForm.btnExitClick(Sender: TObject);
begin
  FWordApp.Quit(EmptyParam, EmptyParam, EmptyParam);
end;

unit ConnectionObject;

interface

uses Word_TLB, dialogs;

type
  TWordConnection = class(TObject, IUnknown, IDispatch)
  protected
    {IUnknown}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    { IDispatch }
    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
      stdcall;
    function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
        stdcall;

  public
    WordApp: _Application;
    WordDoc: _Document;
    AppCookie, DocCookie: Integer;
  end;

implementation

{ IUnknown Methods }

uses windows, activex, main;

procedure LogComment(comment: string);
begin
  Form1.Memo1.Lines.Add(comment);
end;

function TWordConnection._AddRef: Integer;
begin
  Result := 2;
end;

function TWordConnection._Release: Integer;
begin
  Result := 1;
end;

function TWordConnection.QueryInterface(const IID: TGUID;
  out Obj): HResult;
begin
  Result := E_NOINTERFACE;
  Pointer(Obj) := nil;
  if (GetInterface(IID, Obj)) then
    Result := S_OK;
  if not Succeeded(Result) then
    if (IsEqualIID(IID, DocumentEvents) or IsEqualIID(IID, ApplicationEvents))
      then
      if (GetInterface(IDispatch, Obj)) then
        Result := S_OK;
end;

{ IDispatch Methods }

function TWordConnection.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  Result := E_NOTIMPL;
end;

function TWordConnection.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  Pointer(TypeInfo) := nil;
  Result := E_NOTIMPL;
end;

function TWordConnection.GetTypeInfoCount(out Count: Integer): HResult;
begin
  Count := 0;
  Result := E_NOTIMPL;
end;

function TWordConnection.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  //This is the entry point for Word event sinking
  Result := S_OK;
  case DispID of
    1: ; // Startup
    2: ShowMessage('quit'); // Quit
    3: ; // Document change
    4: ; // New document
    5: ; // Open document
    6: ShowMessage('close'); // Close document
  else
    Result := E_INVALIDARG;
  end;
end;

end.