use strict;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Word';

my ($exec_res, $filepath, $oldfile, $editfile, %str_changes, %wingding
+_changes, $return_message, $return_code );

#=====================================================================
+===========
#
# sub edit_word_doc
#
# this sub alters the given word document by
#    substituting one character string with another    and/or
#                 one character string for a wingding or similar symbo
+l
# stores the edited document under given name
#
# arguments
# 1    full path of original document
# 2    full path of edited document
# 3    reference to hash holding the string substitutions
# 4    reference to hash holding the wingding substitutions
# 5    reference to variable holding accumulated messages when failure
+s occur
# 6    reference to return code - 1 OK - 2 failure
#
# structure of string substitution hash
#    $str_sb{a}{b} = v
#    where a is substitution number
#          b is one of
#            target - target string given by v
#            required - required string given by v 
#
# structure of string substitution hash
#    $wng_sb{a}{b} = v
#    where a is substitution number
#          b is one of
#            target - target string given by v
#            wingding - required ASCII number of symbol given by v 
#            font - name of symbol 'font' given by v (for example wing
+dings)
#
#=====================================================================
+============


sub edit_word_doc($$$$$$) {

my ($oldfile, $editfile, $ref_str_sb, $ref_wng_sb, $ref_return_message
+, $ref_return_code) = @_;

my ($word, $doc, $sb_item, $find_sb_item, $fail_cou, $selection);
my ($search, $replace, $search_res, $save_word_res);

# open the given file

$word = Win32::OLE-> GetActiveObject('Word.Application')
    || Win32::OLE-> new('Word.Application','Quit');

$doc = $word->Documents->Open("$oldfile");

#check that $doc inlcudes required characters

if($doc =~ m/OLE=HASH/) {

} else {

    $$ref_return_message = "failure to use given file <$oldfile>\n";
    $$ref_return_code    = 0;

    return
}

# is application visible 0=no  1=yes
$word-> {visible} = 0;

# initialse return values
$$ref_return_message = '';
$$ref_return_code    = 1;

# initialise failure count
$fail_cou = 0;

# substitute using wingdings 

$selection = $word->Selection;

foreach $sb_item (sort {$a <=> $b} keys %$ref_wng_sb) {

    $selection->MoveLeft ({Unit => wdCharacter, Count => 9999});
    $selection->MoveUp   ({Unit => wdLine, Count => 99999});

    $selection->Find->ClearFormatting;
    $selection->Find->{Text} = $ref_wng_sb->{$sb_item}{target};
    $find_sb_item = $selection->Find->Execute;

    if($find_sb_item != 1) {

# failure

        $fail_cou += 1;
        $$ref_return_message .= "wingding - failure to find $ref_wng_s
+b->{$sb_item}{target}\n";

    } else {
        
        $selection->MoveRight ( {Unit => wdCharacter, Count => 1} );

        $selection->InsertSymbol( { Font=> $ref_wng_sb->{$sb_item}{fon
+t}, CharacterNumber => $ref_wng_sb->{$sb_item}{wingding} - 4096, Unic
+ode => 1 });
    }
}

# remove wingding insertion strings


$selection->MoveLeft ({Unit => wdCharacter, Count => 9999});
$selection->MoveUp   ({Unit => wdLine, Count => 99999});

$search =  $doc-> Content->Find;          
$replace = $search-> Replacement;   

# remove wingding insertion strings

foreach $sb_item (sort {$a <=> $b} keys %$ref_wng_sb) {

    $search-> {Text} = $ref_wng_sb->{$sb_item}{target};               
+  
    $replace-> {Text} = "";                
    $search_res = $search-> Execute({Replace => wdReplaceAll});

    if($search_res != 1) {

# failure

        $fail_cou += 1;
        $$ref_return_message .= "wingding - failure to remove $ref_wng
+_sb->{$sb_item}{target}\n";

    }
}

# make character substitutions

foreach $sb_item (sort {$a <=> $b} keys %$ref_str_sb) {

    $search-> {Text} = $ref_str_sb->{$sb_item}{target};               
+  
    $replace-> {Text} = $ref_str_sb->{$sb_item}{required};            
+    
    $search_res = $search-> Execute({Replace => wdReplaceAll});

    if($search_res != 1) {

# failure

        $fail_cou += 1;
        $$ref_return_message .= "string - failure to change $ref_str_s
+b->{$sb_item}{target} for $ref_str_sb->{$sb_item}{required}\n";

    }
}

# save edited file

$save_word_res = $word-> ActiveDocument->SaveAs($editfile);

# close word file
$doc-> Close();
$word-> Quit();

# ensure return code is correct

if($fail_cou > 0) {

    $$ref_return_code    = 0;

}
}



#=====================================================================
+============
#
# test data

$filepath = 'C:\tmp';

# set $filepath to the full path to the direcotry where the file to be
+ changed, test.doc, is stored

$oldfile = $filepath . '\wingding1.doc';
$editfile = $filepath . '\wingding1-edit.doc';

$str_changes{1}{target}   = '#s1';
$str_changes{1}{required} = 'abc';
$str_changes{2}{target}   = '#s2';
$str_changes{2}{required} = 'def';
$str_changes{3}{target}   = '#s3';
$str_changes{3}{required} = 'ghi';
$str_changes{4}{target}   = '#s4';
$str_changes{4}{required} = 'jklmnop';
$str_changes{5}{target}   = '#s5';
$str_changes{5}{required} = 'rstuvwxyz';

$wingding_changes{1}{target}   = '#w1';
$wingding_changes{1}{wingding} = 252;
$wingding_changes{1}{font}     = 'wingdings';
$wingding_changes{2}{target}   = '#w2';
$wingding_changes{2}{wingding} = 70;
$wingding_changes{2}{font}     = 'wingdings 2';
$wingding_changes{3}{target}   = '#w3';
$wingding_changes{3}{wingding} = 200;
$wingding_changes{3}{font}     = 'wingdings 3';
$wingding_changes{4}{target}   = '#w4';
$wingding_changes{4}{wingding} = 40;
$wingding_changes{4}{font}     = 'wingdings 3';
$wingding_changes{5}{target}   = '#w5';
$wingding_changes{5}{wingding} = 38;
$wingding_changes{5}{font}     = 'webdings';

edit_word_doc ($oldfile, $editfile, \%str_changes, \%wingding_changes,
+ \$return_message, \$return_code);

print "\nafter edit doc - return code <$return_code> message <$return_
+message>\n";
[download]