whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

17 Visitors Online


 
...change/read the Document Properties for a specified Word Document?
Autor: Thomas Stutz
[ Print tip ]  

Tip Rating (18):  
     


{ 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 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;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners