Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Win32::ole and MSWord

by Kenny (Novice)
on Sep 15, 2002 at 15:48 UTC ( [id://198045]=sourcecode: print w/replies, xml ) Need Help??
Category: Win32 Stuff
Author/Contact Info KTOMIAK@ATTGLOBAL.NET
Description: Using perl, of course, launch MSWord and build a complex word document. This shows off how to do page setup, headers and footers, insert text, insertsymbol, add a table, put text in the table. I think this is a great example if you just want to get going.
#=================================== perl ============================
+=
#
  use strict ;
#
#    LINKAGE SECTION
#    ---------------

  @pgm::runtime_args = @ARGV ;     # Must be in Main:: routine
  $pgm::maxargs = $#pgm::runtime_args + 1 ;

#
#=====================================================================
+=
#
#  IDENTIFICATION DIVISION:
#  ========================
#
  $program::identifier     = "Perl2Word.pl" ;
  $program::version        = "01.00.00 --- 2002-09-05" ;
  $program::author         = "Kenneth E. Tomiak" ;
  $author::email           = "Kenneth.Tomiak\@ATTGlobal.net" ;
#
#  M O D I F I C A T I O N       L O G
#  -----------------------------------
#
#  Date-Changed
#
#  Date-Completed
#      2002-09-05 Kenneth Tomiak
#      ---------- --------------
#         Version 01.00.00  Origination of code.
#
#---------------------------------------------------------------------
+-
#
#  OWNERSHIP:
#  ==========
#  This program is the property of Kenneth Tomiak.
#  It may not be freely used or distributed without the consent
#  of Kenneth Tomiak. It may not be modified in any form.
#
  $program::copyright = "Copyright (c) 02002 - Kenneth Tomiak : All ri
+ghts reserved." ;
#
#---------------------------------------------------------------------
+-
#
#  DISCLAIMER:
#  ===========
#  In no event will Kenneth Tomiak be liable to the user
#  of this script or any third party for any damages, including
#  any lost profits, lost savings or other incidental,
#  consequential or special damages arising out of the operation
#  of or inability to operate this script, even if the user has been
#  advised of the possibility of such damages.
#
#=====================================================================
+=
#
#  ENVIRONMENT DIVISION:
#  =====================
#    CONFIGURATION SECTION
#    ---------------------
  $source::computer = "Perl on a Windows based Operating System" ;
  $object::computer = "$^O" ;
#
#    INPUT-OUTPUT SECTION
#    --------------------
#      FILE-CONTROL
#      ------------
#
#        INPUT
#        -----
#
#        OUTPUT
#        ------
  $Word::ExePath   = "D:\\Program Files\\Microsoft Office\\Office\\win
+word.exe" ;
  $Document::Path  = "D:\\temp" ;
  $Document::Name1 = "D:\\Temp\\Perl2Word.doc" ;
  $Document::Name2 = "D:\\Temp\\Perl3Word.doc" ;
#
#        I-O
#        ---
#
#      EXTEND MODULES SEARCH PATH
#      --------------------------
#
    use lib "." ;                          # fool it to use running di
+r

#
#=====================================================================
+=
#
#  DATA DIVISION:
#  =============
#    FILE SECTION
#    ------------
#
#        INPUT
#        -----
#
#        OUTPUT
#        ------
#
#        I-O
#        ---
#
#        SORT
#        ----
#
#    WORKING-STORAGE SECTION
#    -----------------------
#      DECLARE MODULES TO BE USED
#      --------------------------
#

#==================================================================#
#                                                                  #
# Include perl modules (can be variables and logic)                #
#                                                                  #
#==================================================================#

  use Win32::OLE;                           # Object Linking and Embed
+ding
  use Win32::OLE::Const 'Microsoft Word';   # Defines constants word k
+nows
  use Win32::Process ;                      # Launch a Windows program

#
#      DECLARE GLOBAL VARIABLES
#      ------------------------

  use constant True  => 1;
  use constant False => 0;

#
#=====================================================================
+=
#
#  PROCEDURE DIVISION:
#  ===================
#    MAIN SECTION
#    ------------
#=====================================================================
+=
# This is the program, it starts the Word application and builds a
# document with lots of fancy formatting to show you how perl does it.
#=====================================================================
+=
Perl2Word: {

#=====================================================================
+=
#    Start word
#=====================================================================
+=
# Start->Programs->Microsoft Word

  eval {$MS::Word = Win32::OLE->GetActiveObject('Word.Application')} ;
  die "Word not installed" if $@ ;
  unless (defined $MS::Word) {
    $MS::Word = Win32::OLE->new('Word.Application', sub {$_[0]->Quit;}
+)
       or die "Oops, cannot start Word" ;
  }

# Close your eyes to what is going on

  $MS::Word->{Visible} = 0 ;        # 0 = Don't watch what happens
  $MS::Word->{DisplayAlerts} = 0 ;  # 0 = do not prompt

#=====================================================================
+=
#    Add a new document
#=====================================================================
+=
# Alt-File->New->{Blank Document}

#  Documents.Add Template:= "D:\program files\microsoft office\Templat
+es\Normal.dot", NewTemplate:= False

  my $doc1 = $MS::Word ->Documents->Add() ;            # Create a new 
+document

# Get a pointer for later

#  Windows("Document1").Activate

  $Active::Document = $MS::Word->Selection() ; # Gets the currently se
+lected object

#=====================================================================
+=
#    Page Setup
#=====================================================================
+=
# Alt-File->Page Setup

#
# With ActiveDocument.PageSetup
#   .LineNumbering.Active = False
#   .Orientation = wdOrientLandscape
#   .TopMargin = InchesToPoints(1.2)
#   .BottomMargin = InchesToPoints(1.2)
#   .LeftMargin = InchesToPoints(0.9)
#   .RightMargin = InchesToPoints(0.9)
#   .Gutter = InchesToPoints(0)
#   .HeaderDistance = InchesToPoints(0.5)
#   .FooterDistance = InchesToPoints(0.5)
#   .PageWidth = InchesToPoints(11)
#   .PageHeight = InchesToPoints(8.5)
#   .FirstPageTray = wdPrinterDefaultBin
#   .OtherPagesTray = wdPrinterDefaultBin
#   .SectionStart = wdSectionNewPage
#   .OddAndEvenPagesHeaderFooter = False
#   .DifferentFirstPageHeaderFooter = False
#   .VerticalAlignment = wdAlignVerticalTop
#   .SuppressEndnotes = False
#   .MirrorMargins = False
# End With
#

  $Active::Document->PageSetup->{LineNumbering} = 0 ;
  $Active::Document->PageSetup->{Orientation} = wdOrientPortrait ;
  $Active::Document->PageSetup->{TopMargin} = 18 ; #   .25 inch
  $Active::Document->PageSetup->{BottomMargin} = 18 ; # .25 inch
  $Active::Document->PageSetup->{LeftMargin} = 22 ; #  .25 inch
  $Active::Document->PageSetup->{RightMargin} = 18 ; # .25 inch
  $Active::Document->PageSetup->{Gutter} = 0 ;     #  0.   inch
  $Active::Document->PageSetup->{HeaderDistance} = 18 ; # .25 inch
  $Active::Document->PageSetup->{FooterDistance} = 18 ; # .25 inch
  $Active::Document->PageSetup->{PageWidth} = 612 ; # 8.5 inches
  $Active::Document->PageSetup->{PageHeight} = 792 ; # 11.0  inches
  $Active::Document->PageSetup->{FirstPageTray} = wdPrinterDefaultBin 
+;
  $Active::Document->PageSetup->{OtherPagesTray} = wdPrinterDefaultBin
+ ;
  $Active::Document->PageSetup->{SectionStart} = wdSectionNewPage ;
  $Active::Document->PageSetup->{OddAndEvenPagesHeaderFooter} = 0 ;
  $Active::Document->PageSetup->{DifferentFirstPageHeaderFooter} = 0 ;
  $Active::Document->PageSetup->{VerticalAlignment} = wdAlignVerticalT
+op ;
  $Active::Document->PageSetup->{SuppressEndnotes} = 0 ;
  $Active::Document->PageSetup->{MirrorMargins} = 0 ;

#=====================================================================
+=
#    Create a Header
#=====================================================================
+=
#   If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindo
+w.ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.Vie
+w.Type = wdMasterView Then
#       ActiveWindow.ActivePane.View.Type = wdPageView
#   End If
  $MS::Word->ActiveWindow->ActivePane->View->{Type} = wdPageView ;

#   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  $MS::Word->ActiveWindow->ActivePane->View->{SeekView} = wdSeekCurren
+tPageHeader ; #

#=====================================================================
+=
#    Add a border to the paragraph
#=====================================================================
+=
#   With Selection.ParagraphFormat
#     .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
#     .Borders(wdBorderRight).LineStyle = wdLineStyleNone
#     .Borders(wdBorderTop).LineStyle = wdLineStyleNone
#     With .Borders(wdBorderBottom)
#       .LineStyle = wdLineStyleSingle
#       .LineWidth = wdLineWidth050pt
#       .ColorIndex = wdAuto
#     End With
#     With .Borders
#       .DistanceFromTop = 1
#       .DistanceFromLeft = 4
#       .DistanceFromBottom = 1
#       .DistanceFromRight = 4
#       .Shadow = False
#     End With
#   End With
#   With Options
#     .DefaultBorderLineStyle = wdLineStyleTriple
#     .DefaultBorderLineWidth = wdLineWidth150pt
#     .DefaultBorderColorIndex = wdAuto
#   End With
  $Active::Document->ParagraphFormat->Borders(wdBorderLeft)->{LineStyl
+e} = wdLineStyleNone ;
  $Active::Document->ParagraphFormat->Borders(wdBorderRight)->{LineSty
+le} = wdLineStyleNone ;
  $Active::Document->ParagraphFormat->Borders(wdBorderTop)->{LineStyle
+} = wdLineStyleNone ;
  $Active::Document->ParagraphFormat->Borders(wdBorderBottom)->{LineWi
+dth} = wdLineWidth150pt ;
  $Active::Document->ParagraphFormat->Borders(wdBorderBottom)->{LineSt
+yle} = wdLineStyleTriple ;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromTop} = 1 ;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromLeft} = 4 
+;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromBottom} = 
+1 ;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromRight} = 4
+ ;

  $Active::Document->Style('ActiveDocument->Styles' =>"Header") ;
  $Active::Document->Font->{Name} = 'Times New Roman' ;
  $Active::Document->Font->{Size} = 10 ;
  $Active::Document->Font->{Bold} = 1 ;
  $Active::Document->Font->{ColorIndex} = wdBlack ;

#=====================================================================
+=
#    Insert an AutoTextEntry
#=====================================================================
+=
#   NormalTemplate.AutoTextEntries("Created by").Insert Where:=Selecti
+on.Range
  $MS::Word->NormalTemplate->AutoTextEntries("Created by")->Insert($Ac
+tive::Document->Range);

#=====================================================================
+=
#    Switch to the Footer
#=====================================================================
+=
#   If Selection.HeaderFooter.IsHeader = True Then
#       ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFoote
+r
#   Else
#       ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeade
+r
#   End If
#   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  $MS::Word->ActiveWindow->ActivePane->View->{SeekView} = wdSeekCurren
+tPageFooter ; #

#=====================================================================
+=
#    Add a border to the paragraph
#=====================================================================
+=
  $Active::Document->ParagraphFormat->Borders(wdBorderLeft)->{LineStyl
+e} = wdLineStyleNone ;
  $Active::Document->ParagraphFormat->Borders(wdBorderRight)->{LineSty
+le} = wdLineStyleNone ;
  $Active::Document->ParagraphFormat->Borders(wdBorderTop)->{LineWidth
+} = wdLineWidth225pt ;
  $Active::Document->ParagraphFormat->Borders(wdBorderTop)->{LineStyle
+} = wdLineStyleSingle ;
  $Active::Document->ParagraphFormat->Borders(wdBorderBottom)->{LineSt
+yle} = wdLineStyleNone ;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromTop} = 1 ;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromLeft} = 4 
+;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromBottom} = 
+1.25 ;
  $Active::Document->ParagraphFormat->Borders->{DistanceFromRight} = 4
+ ;

#=====================================================================
+=
#    Insert a bunch of AutoTextEntries
#=====================================================================
+=
#   NormalTemplate.AutoTextEntries("Filename").Insert Where:=Selection
+.Range
  $MS::Word->NormalTemplate->AutoTextEntries("Filename")->Insert($Acti
+ve::Document->Range);

#   Selection.TypeText Text:=vbTab
  $Active::Document->TypeText("\t") ;

#   Selection.InsertDateTime DateTimeFormat:="dddd, MMMM dd, yyyy", In
+sertAsField:=False
  $Active::Document->InsertDateTime("dddd, MMMM dd, yyyy",0) ;

#   Selection.TypeText Text:=vbTab
  $Active::Document->TypeText("\t") ;

#=====================================================================
+=
#    Insert a symbol
#=====================================================================
+=
#   Selection.InsertSymbol Font:="Webdings", CharacterNumber:=-3941, U
+nicode:= True
  $Active::Document->InsertSymbol($Active::Document->InsertSymbol(-394
+1,"Webdings", 1));

# $Active::Document->Font->{Name} = 'Webdings' ;
# $m::o = "\234" ;
# $Active::Document->TypeText($m::o) ;
# $Active::Document->Font->{Name} = 'Times New Roman' ;

  $Active::Document->TypeText("K.Tomiak\@Schunk-Associates.com") ;

#   Selection.TypeText Text:=vbTab
  $Active::Document->TypeText("\t") ;

#   NormalTemplate.AutoTextEntries("Page X of Y").Insert Where:=Select
+ion. Range
  $MS::Word->NormalTemplate->AutoTextEntries("Page X of Y")->Insert($A
+ctive::Document->Range);

#=====================================================================
+=
#    Back to the body of the document
#=====================================================================
+=
#   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
  $MS::Word->ActiveWindow->ActivePane->View->{SeekView} = wdSeekMainDo
+cument ;

#=====================================================================
+=
#    Set a style but then center it
#=====================================================================
+=
#   Selection.Style = ActiveDocument.Styles("Heading 1")
  $Active::Document->{Style}=('ActiveDocument->Styles'=>"Heading 1") ;

#=====================================================================
+=
#    Enter some text
#=====================================================================
+=
#   Selection.TypeText Text:="Now"
  $Active::Document->TypeText("Now") ;
  $Active::Document->ParagraphFormat->{Alignment} = wdAlignParagraphCe
+nter ;

#   Selection.TypeParagraph
  $Active::Document->TypeParagraph() ;

  $Active::Document->{Style}=('ActiveDocument->Styles'=>"Normal") ;

#=====================================================================
+=
#    Add a table with two rows and two columns
#=====================================================================
+=
#   ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumC
+olumns:= 2
  my $Table1 = $doc1->Tables->Add($Active::Document->Range,2,2) ;

#=====================================================================
+=
#    Move down two lines and then up three, for the fun of it
#=====================================================================
+=
#   Selection.MoveDown Unit:=wdLine, Count:=2
  $Active::Document->MoveDown(wdLine,2) ; # 2 lines down

#   Selection.MoveUp Unit:=wdLine, Count:=3
  $Active::Document->MoveUp(wdLine,3) ; # 3 lines down


#=====================================================================
+=
#    Set the Font to something different
#=====================================================================
+=
#   Selection.Font.Size = 12
  $Active::Document->Font->{Name} = 'Courier' ;
  $Active::Document->Font->{Bold} = 1 ;
  $Active::Document->Font->{Size} = 12 ;

#=====================================================================
+=
#    Put some text into the first row column 1
#=====================================================================
+=
#   Selection.TypeText Text:="Ken"
  $Active::Document->TypeText("Ken") ;
#=====================================================================
+=
#    Put some text into the second row column 2
#=====================================================================
+=
# Another way to fill in a cell
  $Table1->Cell(2 ,2 )->Range->{Text}="Saturday" ;

#=====================================================================
+=
#    Move around and populate the other cells
#=====================================================================
+=
#   Selection.MoveRight Unit:=wdCharacter, Count:=1
  $Active::Document->MoveRight(1,1) ; # 1 characters right

#   Selection.TypeText Text:="Bob"
  $Active::Document->TypeText("Bob") ;

#   Selection.MoveRight Unit:=wdCharacter, Count:=2
  $Active::Document->MoveRight(1,2) ; # 2 characters right

#   Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  $Active::Document->ParagraphFormat->{Alignment} = wdAlignParagraphCe
+nter ;

#   Selection.TypeText Text:="George"
  $Active::Document->Font->{Name} = 'Arial' ;
  $Active::Document->Font->{Bold} = 0 ;
  $Active::Document->Font->{Size} = 6 ;
  $Active::Document->TypeText("George") ;

#   Selection.MoveRight Unit:=wdCell
  $Active::Document->MoveRight(wdCell,1) ; # 1 characters right

#=====================================================================
+=
#    Mostly forcing rows to stay on the same page instead of splitting
#    using table cell height you get both statements shown below.
#=====================================================================
+=
#   Selection.Cells.HeightRule = wdRowHeightAuto
  $Active::Document->Tables(1)->Cell(1,1)->{HeightRule} = wdRowHeightA
+uto ;
#   With Selection.Tables(1).Rows
#       .Alignment = wdAlignRowLeft
#       .AllowBreakAcrossPages = False
#       .SetLeftIndent LeftIndent:=InchesToPoints(0), RulerStyle:= wdA
+djustNone
#   End With
  $Active::Document->Tables(1)->Rows->{Alignment} = wdAlignRowLeft ;
  $Active::Document->Tables(1)->Rows->{AllowBreakAcrossPages} = 0 ; #F
+alse
# $Active::Document->Tables(1)->Rows->{SetLeftIndent} = 0 ; #False
  $Active::Document->Tables(1)->Rows->SetLeftIndent(0.0,wdAdjustNone) 
+;

#=====================================================================
+=
#    Set the width of column 1 (hint point size affects inches 72 = 1 
+inch)
#=====================================================================
+=
#   Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=302.4, RulerS
+tyle:= wdAdjustNone
  $Active::Document->Tables(1)->Columns(1)->SetWidth(302.4,wdAdjustNon
+e) ;

#=====================================================================
+=
#    Move down and out of the table, I think
#=====================================================================
+=
#   Selection.MoveDown Unit:=wdLine, Count:=2
  $Active::Document->MoveDown(5,2) ; # 2 lines down
  $Active::Document->ParagraphFormat->{Alignment} = wdAlignParagraphCe
+nter ;
#
#=====================================================================
+=
#    Enter some text
#=====================================================================
+=

#   Selection.TypeText Text:="and then."
  $Active::Document->TypeText("and then.") ;

  $doc1->SaveAs(\$Document::Name1);
  $doc1->Close();

# Just to prove another document can be made
  my $doc2 = $MS::Word ->Documents->Add() ; # Create a new document
  $Alternate::Document = $MS::Word->Selection() ; # Gets the currently
+ selected object
  $Alternate::Document->PageSetup->{Orientation} = wdOrientLandscape ;

  $doc2->SaveAs(\$Document::Name2);
  $doc2->Close();

  $MS::Word->Quit();

  Win32::Process::Create($Process::Obj,
    "$Word::ExePath",
    "winword $Document::Name1",
    0,
    NORMAL_PRIORITY_CLASS,
    "$Document::Path") || die ErrorReport();

  $Process::Obj->Suspend();
  $Process::Obj->Resume();
  $Process::Obj->Wait(1);
  exit 0 ;
}

sub ErrorReport: {
  print "Something bad went down.\n" ;
}
Replies are listed 'Best First'.
Re: Win32::ole and MSWord
by vek (Prior) on Sep 15, 2002 at 17:48 UTC
    LINKAGE SECTION IDENTIFICATION DIVISION ENVIRONMENT DIVISION WORKING-STORAGE SECTION
    We use COBOL for some of our legacy applications here. I've never seen these particular statements in Perl code however, interesting...

    -- vek --
      Running this code, I was prompted to save my document and confirm its name. Is there a way to force the document to save and accept the name given, without user interaction?
        4 Years late but may be useful to others, Haven't read all the code but i've used this statement when i've been using OLE
        $Active::Document->{Saved} = 1; $Active::Document->Close;
        Although to be honest, You're better to use the save as like Kenny did. Here's some more on SaveAs() method if anyone needs an example:
        my $MSDN_const = { %{ Win32::OLE::Const->Load("Microsoft Word 11.0 Object Library +") } }; # Save as normal MS Word document $Active::Document->SaveAs( { FileName=>'C:\\My_Word_Document.doc', FileFormat=>$MSDN_const->{wdFormatDocument} } ); # Save in XML format $Active::Document->SaveAs( { FileName=>'C:\\My_XML_Document.xml', FileFormat=>$MSDN_const->{wdFormatXML} } );

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://198045]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-03-29 12:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found