#!/usr/bin/perl -w

# Uses
use strict;
use Win32::OLE;
use Win32::OLE::Variant;
use Win32::OLE::Const;
use File::Find;

# We want to handle collections
Win32::OLE->Option(_NewEnum => 1);

# Variables
use vars qw($MSWord $wd $startdir);

# Where to start the doc search
$startdir='d:/documents';

# Create new MSWord object and load constants
$MSWord=Win32::OLE->new('Word.Application','Quit') or
	die "Could not load MS Word";
$wd=Win32::OLE::Const->Load($MSWord);

# Find documents
find(\&getProps,$startdir);

######################################
sub getProps {

	# Find sub

	# We only want .doc files
	return unless /\.doc/ && -f;

	# No OLE warnings please
	local $Win32::OLE::Warn = 0;

	# Open document
	my $doc = $MSWord->Documents->Open({FileName=>$File::Find::name});

	# Exit nicely if we couldn't open doc
	return unless $doc;

	# Print header
	print "\n-----------------------------------------------\n";
	print "Document: $File::Find::name\n";
	print "-----------------------------------------------\n";

	# List document properties
	foreach my $prop (@{$doc->BuiltInDocumentProperties->{_NewEnum}},
		@{$doc->CustomDocumentProperties->{_NewEnum}}) {
		if (defined $prop->{Name}) {
			print $prop->{Name};
			if (defined $prop->{Value}) {
				# Variants...
				if ($prop->{Value}=~/^Win32::OLE::Variant/) {
					print ": ".valof $prop->{Value};
				} else {
					print ": ".$prop->{Value};
				}
			} else {
				print ": undefined"
			}
			print "\n";
		}
	}

	# Close document
	$doc->Close({SaveChanges=>$wd->{wdDoNotSaveChanges}});
}