Как прочитать/изменить свойства Word документа?

{ 1. Change MS Word properties via OLE } 
 
uses 
  ComObj; 
 
procedure TForm1.Button1Click(Sender: TObject); 
const 
  wdPropertyTitle = $00000001; 
  wdPropertySubject = $00000002; 
  wdPropertyAuthor = $00000003; 
  wdPropertyKeywords = $00000004; 
  wdPropertyComments = $00000005; 
  wdPropertyTemplate = $00000006; 
  wdPropertyLastAuthor = $00000007; 
  wdPropertyRevision = $00000008; 
  wdPropertyAppName = $00000009; 
  wdPropertyTimeLastPrinted = $0000000A; 
  wdPropertyTimeCreated = $0000000B; 
  wdPropertyTimeLastSaved = $0000000C; 
  wdPropertyVBATotalEdit = $0000000D; 
  wdPropertyPages = $0000000E; 
  wdPropertyWords = $0000000F; 
  wdPropertyCharacters = $00000010; 
  wdPropertySecurity = $00000011; 
  wdPropertyCategory = $00000012; 
  wdPropertyFormat = $00000013; 
  wdPropertyManager = $00000014; 
  wdPropertyCompany = $00000015; 
  wdPropertyBytes = $00000016; 
  wdPropertyLines = $00000017; 
  wdPropertyParas = $00000018; 
  wdPropertySlides = $00000019; 
  wdPropertyNotes = $0000001A; 
  wdPropertyHiddenSlides = $0000001B; 
  wdPropertyMMClips = $0000001C; 
  wdPropertyHyperlinkBase = $0000001D; 
  wdPropertyCharsWSpaces = $0000001E; 
const 
  AWordDoc = 'C:\Test.doc'; 
  wdSaveChanges = $FFFFFFFF; 
var 
  WordApp: OLEVariant; 
  SaveChanges: OleVariant; 
begin 
  try 
    WordApp := CreateOleObject('Word.Application'); 
  except 
    // Error.... 
    Exit; 
  end; 
  try 
    WordApp.Visible := False; 
    WordApp.Documents.Open(AWordDoc); 
    WordApp.ActiveDocument.BuiltInDocumentProperties[wdPropertyTitle].Value := 'Your Title...'; 
    WordApp.ActiveDocument.BuiltInDocumentProperties[wdPropertySubject].Value := 'Your Subject...'; 
    // ... 
    // ... 
  finally 
    SaveChanges := wdSaveChanges; 
    WordApp.Quit(SaveChanges, EmptyParam, EmptyParam); 
  end; 
end; 

{ 
  2. Read MS Word properties via Structured Storage. 
  by Serhiy Perevoznyk 
} 
uses 
  ComObj, ActiveX; 
 
const 
  FmtID_SummaryInformation: TGUID = 
    '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}'; 
 
function FileTimeToDateTimeStr(F: TFileTime): string; 
var 
  LocalFileTime: TFileTime; 
  SystemTime: TSystemTime; 
  DateTime: TDateTime; 
begin 
  if Comp(F) = 0 then Result := '-' 
  else  
  begin 
    FileTimeToLocalFileTime(F, LocalFileTime); 
    FileTimeToSystemTime(LocalFileTime, SystemTime); 
    with SystemTime do 
      DateTime := EncodeDate(wYear, wMonth, wDay) + 
        EncodeTime(wHour, wMinute, wSecond, wMilliseconds); 
    Result := DateTimeToStr(DateTime); 
  end; 
end; 
 
function GetDocInfo(const FileName: WideString): string; 
var 
  I: Integer; 
  PropSetStg: IPropertySetStorage; 
  PropSpec: array[2..19] of TPropSpec; 
  PropStg: IPropertyStorage; 
  PropVariant: array[2..19] of TPropVariant; 
  Rslt: HResult; 
  S: string; 
  Stg: IStorage; 
begin 
  Result := ''; 
  try 
    OleCheck(StgOpenStorage(PWideChar(FileName), nil, STGM_READ or 
      STGM_SHARE_DENY_WRITE, 
      nil, 0, Stg)); 
    PropSetStg := Stg as IPropertySetStorage; 
    OleCheck(PropSetStg.Open(FmtID_SummaryInformation, 
      STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg)); 
    for I := 2 to 19 do 
    begin 
      PropSpec[I].ulKind := PRSPEC_PROPID; 
      PropSpec[I].PropID := I; 
    end; 
    Rslt := PropStg.ReadMultiple(18, @PropSpec, @PropVariant); 
    OleCheck(Rslt); 
    if Rslt <> S_FALSE then for I := 2 to 19 do 
      begin 
        S := ''; 
        if PropVariant[I].vt = VT_LPSTR then 
          if Assigned(PropVariant[I].pszVal) then 
            S := PropVariant[I].pszVal; 
        case I of 
          2:  S  := Format('Title: %s', [S]); 
          3:  S  := Format('Subject: %s', [S]); 
          4:  S  := Format('Author: %s', [S]); 
          5:  S  := Format('Keywords: %s', [S]); 
          6:  S  := Format('Comments: %s', [S]); 
          7:  S  := Format('Template: %s', [S]); 
          8:  S  := Format('Last saved by: %s', [S]); 
          9:  S  := Format('Revision number: %s', [S]); 
          10: S := Format('Total editing time: %g sec', 
              [Comp(PropVariant[I].filetime) / 1.0E9]); 
          11: S := Format('Last printed: %s', 
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]); 
          12: S := Format('Create time/date: %s', 
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]); 
          13: S := Format('Last saved time/date: %s', 
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]); 
          14: S := Format('Number of pages: %d', [PropVariant[I].lVal]); 
          15: S := Format('Number of words: %d', [PropVariant[I].lVal]); 
          16: S := Format('Number of characters: %d', 
              [PropVariant[I].lVal]); 
          17:; // thumbnail 
          18: S := Format('Name of creating application: %s', [S]); 
          19: S := Format('Security: %.8x', [PropVariant[I].lVal]); 
        end; 
        if S <> '' then Result := Result + S + #13; 
      end; 
  finally 
  end; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if Opendialog1.Execute then 
    ShowMessage(GetDocInfo(opendialog1.FileName)); 
end; 

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php