General: How to duplicate VBA code in Perl using OLE

    This is by no means a Frequently Asked Question. But I still decided to add it since I haven't yet seen anything equivalent anywhere.  The code and article was emailed to me by  Norris Couch.   The contents of that email follow:

I have since found out that I can duplicate my VBA code in Perl using OLE.  So, attached is my 500 line Perl program  This code is unique to my database/needs but the ideas should be useful to anyone else trying to follow this path. Jan Dubois in Germany was of great help since he assisted me in getting WIN32 OLE working with Perl.  

'***************** Code Start ***************
'This code was originally written by Norris Couch. 
'It is not to be altered or distributed, 
'except as part of an application. 
'You are free to use it in any application,  
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Norris Couch.
#!perl -w

# Move the Access results to Excel for further processing
#
# Call as:
#
#   MONTHXLS
#

use strict;
use Cwd;
use Win32::OLE qw(in with);
use Win32::OLE::Variant;
use Win32::OLE::Const 'Microsoft Excel';
$Win32::OLE::Warn = 2; # Always warn with verbose error messages
use constant TRUE  => 1;
use constant FALSE => 0;

# Debugging variable
use constant clDEBUG => FALSE; # True to see debug output
$= = 9999 if (clDEBUG); # set the page length to 9999 lines

# Global Variables
my $loAccess;   # Access Object
my $loExcel;    # Excel Object
my $loDatabase; # Database Object
my $loXlw;      # Workbook Object
my $loXls;      # Spreadsheet Object
my $loRS;       # Recordset Object
my $lcSQL;      # SQL Query string
my $lcSaveDir;  # Default Access Directory string

# Global Output field names
my ($lclabel, $lncount, $lnpercent, $lnnsi, $lcci);
# Global Row/Column Positioning names
my ($lnRow, $lnCol);

# Use existing instance if Access is already running or start Access
eval {$loAccess = Win32::OLE->GetActiveObject('Access.Application')};
die "Access not installed" if $@;
unless (defined $loAccess) {
  $loAccess = Win32::OLE->new('Access.Application','Quit')
    or die "Unable to start Access";
}
# This database contains some queries that consolidate other databases and
# address those databases ..\path\database.  In order for these to run under
# OLE, the GLOBAL! Access default database directory must be updated.  This
# saves the current value and later restores it BUT IF THIS PROGRAM DOES NOT
# GET TO THE RESTORE CODE the default will continue to point to this
# directory!
$lcSaveDir = $loAccess->GetOption('Default Database Directory');
$loAccess->SetOption("Default Database Directory", cwd());

# Open the monthly database in the current directory
$loDatabase = $loAccess->DBEngine->OpenDatabase('rs6kcpc.mdb');
if (Win32::OLE->LastError) {
  print "Unable to Open Access Database, LastError returned ",
        Win32::OLE->LastError, "\n";
}

# Use existing instance if Excel is already running or start Excel
eval {$loExcel = Win32::OLE->GetActiveObject('Excel.Application')};
die "Excel not installed" if $@;
unless (defined $loExcel) {
  $loExcel = Win32::OLE->new('Excel.Application.8','Quit')
    or die "Unable to start Excel";
}

# Set up Excel workbook with only one worksheet
$loXlw = $loExcel->Workbooks->Add(xlWBATWorksheet)
  or die "Unable to create a new Excel workbook\n";

# Process Overall NSI Query
$loRS = $loDatabase->OpenRecordset('RS6KCPC Overall NSI');
if (Win32::OLE->LastError) {
  print "Unable to Open RS6KCPC Overall NSI, LastError returned ",
        Win32::OLE->LastError, "\n";
}

$loXls = $loXlw->ActiveSheet; # set Worksheet Object
$loXls->{Name} = "Overall"; # Name the Worksheet
$loRS->MoveFirst();
$lclabel = '';
$lncount = '';
$lnpercent = '';
$loXls->Range("C1")->{Value} = $lnnsi = $loRS->Fields('NSI')->Value;
with($loXls->Columns(3), NumberFormat        => '#0.0',
                         HorizontalAlignment => xlRight);
$loXls->Range("D1")->{Value} = $lcci = $loRS->Fields('95% CI')->Value;
with($loXls->Columns(4), HorizontalAlignment => xlRight);
$loXls->Range("C:D")->Columns->AutoFit;
write if (clDEBUG);
print "\n" if (clDEBUG);

# Process NSI by Channel
Common_Query('Channel','RS6KCPC NSI by Channel');

# Process NSI by Usage
Common_Query('Usage', 'RS6KCPC NSI by Usage');

# Process NSI by Primary Usage
Common_Query('PrimeUse', 'RS6KCPC NSI by Primary Usage');

# Process NSI by Source
Common_Query('Source', 'RS6KCPC NSI by Source');

# Process NSI by BMT
Common_Query('BMT', 'RS6KCPC NSI by BMT');

# Process Rolling 3 Month NSI by Type/Model
$lcSQL = <<ENDSQL;
SELECT groupings AS [Type/Model], Count(satisfaction) AS Count,
sum/count AS NSI, Sum(satisfaction) AS sum, StDev(satisfaction) AS StdDev,
1.96*(StdDev/Sqr(count)) AS CI, IIF(isnull([CI]),"","+/- " &
Format((Int(([CI]+0.005)*100)/100),"#0.00")) AS [95% CI]
FROM [RS6KCPC Rolling 3 Month Union] LEFT JOIN PDT_TypeModels ON
[RS6KCPC Rolling 3 Month Union].typemodel = PDT_TypeModels.TypeModel
WHERE satisfaction>=0 AND groupings<>''
GROUP BY groupings;
ENDSQL

Rolling_Query('TypeModel');

# Process Rolling 3 Month NSI by Install Month
$lcSQL = <<ENDSQL;
SELECT year & " - " & Format(month,"#00") AS Year_Month,
Count(satisfaction) AS Count, sum/count AS NSI, Sum(satisfaction) AS sum,
StDev(satisfaction) AS StdDev, 1.96*(StdDev/Sqr(count)) AS CI,
IIF(isnull([CI]),"","+/- " &
Format((Int(([CI]+0.005)*100)/100),"#0.00")) AS [95% CI]
FROM [RS6KCPC Rolling 3 Month Union]
WHERE satisfaction>=0
GROUP BY year, month;
ENDSQL

Rolling_Query('InstallMonth');

# Process Comment Keyword Count Table
Keyword_Query('Keyword', 'RS6KCPC Comment Keyword Count Table');

# Build Summary worksheet
Build_Summary('Summary');

$loAccess->SetOption("Default Database Directory", $lcSaveDir);
$loAccess->SetOption("Default Database Directory", 'c:\WINNT\Profiles\Administrator\Personal');
unlink(cwd() . "\\" . 'monthxls.xls');
$loXlw->SaveAs(cwd() . "\\" . 'monthxls.xls');
exit;

sub Common_Query
{
  my $lcName = shift;   # get worksheet name
  $lcSQL = shift;       # get query name

  $loXls = $loXlw->WorkSheets->Add({after =>
     $loXlw->Worksheets($loXlw->Worksheets->{Count})});
  $loXls->{Name} = $lcName; # Name the Worksheet

  # get results of query
  $loRS = $loDatabase->OpenRecordset($lcSQL);
  if (Win32::OLE->LastError) {
    print "Common_Query Unable to Open Recordset($lcName), ",
          "LastError returned ", Win32::OLE->LastError, "\n";
  }

  $lnRow = 1;
  $lncount = '';
  $loRS->MoveFirst();
  while (!$loRS->EOF()) {
    $loXls->Range("A$lnRow:D$lnRow")->{Value} =
       [ $lclabel   =                  $loRS->Fields(0)->Value,
         $lnpercent = sprintf("%2.2f", $loRS->Fields('Percent')->Value),
         $lnnsi     = sprintf("%2.1f", $loRS->Fields('NSI')->Value),
         $lcci      =                  $loRS->Fields('95% CI')->Value
       ];
    write if (clDEBUG);
    $lnRow++;
    $loRS->MoveNext();
  }
  print "\n" if (clDEBUG);
  $loXls->Columns(2)->{NumberFormat} = '#0.00';
  $loXls->Columns(3)->{NumberFormat} = '#0.0';
  $loXls->Range("A:A")->{HorizontalAlignment} = xlLeft;
  $loXls->Range("C:D")->{HorizontalAlignment} = xlRight;
  $loXls->Range("A:D")->Columns->AutoFit;
}

sub Rolling_Query
{
  my $lcName = shift;   # get worksheet name
  $lcSQL =~ s/\n/ /g;     # newline ==> space

  $loXls = $loXlw->WorkSheets->Add({after =>
    $loXlw->Worksheets($loXlw->Worksheets->{Count})});
  $loXls->{Name} = $lcName; # Name the Worksheet

  # get results of query
  $loRS = $loDatabase->OpenRecordset($lcSQL);
  if (Win32::OLE->LastError) {
    print "Rolling_Query Unable to Open Recordset($lcName), ",
          "LastError returned ", Win32::OLE->LastError, "\n";
  }

  $lnRow = 1;
  $lnpercent = '';
  $loRS->MoveFirst();
  while (!$loRS->EOF()) {
    $loXls->Range("A$lnRow:D$lnRow")->{Value} =
      [$lclabel   =                  $loRS->Fields(0)->Value,
       $lncount   =                  $loRS->Fields('Count')->Value,
       $lnnsi     = sprintf("%2.1f", $loRS->Fields('NSI')->Value),
       $lcci      =                  $loRS->Fields('95% CI')->Value];
    write if (clDEBUG);
    $lnRow++;
    $loRS->MoveNext();
  }
  print "\n" if (clDEBUG);
  $loXls->Columns(2)->{NumberFormat} = '#0';
  $loXls->Columns(3)->{NumberFormat} = '#0.0';
  $loXls->Range("A:A")->{HorizontalAlignment} = xlLeft;
  $loXls->Range("B:D")->{HorizontalAlignment} = xlRight;
  $loXls->Range("A:D")->Columns->AutoFit;
}

sub Keyword_Query
{
  my $lcName = shift;   # get worksheet name
  $lcSQL = shift;       # get query name

  $loXls = $loXlw->WorkSheets->Add({after =>
    $loXlw->Worksheets($loXlw->Worksheets->{Count})});
  $loXls->{Name} = $lcName; # Name the Worksheet

  # get results of query
  $loRS = $loDatabase->OpenRecordset($lcSQL);
  if (Win32::OLE->LastError) {
    print "Keyword_Query Unable to Open Recordset($lcName), ",
          "LastError returned ", Win32::OLE->LastError, "\n";
  }

  $lnRow = 1;
  $loRS->MoveFirst();
  while (!$loRS->EOF()) {
    $loXls->Range("A$lnRow:E$lnRow")->{Value} =
      [$lclabel   =                  $loRS->Fields('Description')->Value,
       $lncount   =                  $loRS->Fields('Positive')->Value,
       $lnpercent = sprintf("%2.2f", $loRS->Fields('% Positive')->Value),
       $lnnsi     =                  $loRS->Fields('Negative')->Value,
       $lcci      = sprintf("%2.2f", $loRS->Fields('% Negative')->Value)];
    write if (clDEBUG);
    $lnRow++;
    $loRS->MoveNext();
  }
  print "\n" if (clDEBUG);
  $loXls->Columns(2)->{NumberFormat} = '#0';
  $loXls->Columns(3)->{NumberFormat} = '#0.00';
  $loXls->Columns(4)->{NumberFormat} = '#0';
  $loXls->Columns(5)->{NumberFormat} = '#0.00';
  $loXls->Range("A:A")->{HorizontalAlignment} = xlLeft;
  $loXls->Range("B:E")->{HorizontalAlignment} = xlRight;
  $loXls->Range("A:E")->Columns->AutoFit;
}

sub Build_Summary
{
  my $lcName = shift;   # get worksheet name

  $loXls = $loXlw->WorkSheets->Add({before => $loXlw->Worksheets('Overall')});
  $loXls->{Name} = $lcName; # Name the Worksheet

  $lnRow = $lnCol = 1;
  my ($intLoopRow, $intLoopCol);
  # Column labels
  $loXls->Range("B$lnRow:O$lnRow")->{Value} =
    ['Percent',  'NSI',       '95% CI',   undef, undef,
     'Count',    'NSI',       '95% CI',   undef, undef,
     'Positive', '%Positive', 'Negative', '% Negative'];

  # Overall
  $lnRow = 3;
  $loXls->Cells($lnRow, 1)->{Value} = 'Overall Satisfaction: (NSI)';
  $loXls->Cells($lnRow, 1)->Font->{Italic} = TRUE;
  $lnRow++;
  $intLoopRow = 1;
  while ($intLoopRow < 2) {
    # Loop through each saved cell row
    $lnCol = $intLoopCol = 3;
    while ($intLoopCol < 5) {
      $loXls->Cells($lnRow, $lnCol)->{Value} =
        $loXlw->Worksheets('Overall')->Cells($intLoopRow, $intLoopCol)->Value;
      $lnCol++;
      $intLoopCol++;
    }
    $lnRow++;
    $intLoopRow++;
  }

  # BMT
  Move_Sheet1('BMT', 'RS/6000 BMT:');

  # Channel
  Move_Sheet1('Channel', 'Respondent How Acquired:');

  # Usage
  Move_Sheet1('Usage', 'Respondent Server/Workstation Usage:');

  # Primary Usage
  Move_Sheet1('PrimeUse', 'Respondent Segments:');

  # Source
  Move_Sheet1('Source', 'Respondent Installation Types:');

  # Type/Model
  $lnRow = 2; # Move_Sheet2 immediately increments this so this is really 3
  Move_Sheet2('TypeModel', 'Rolling 3 months by Type/Model Groupings:');

  # Install Month
  Move_Sheet2('InstallMonth', 'Rolling 3 months by Install Month:');

  # Keyword
  $lnRow = 3;
  $loXls->Cells($lnRow, 11)->{Value} = 'Comment Keyword Summary';
  $loXls->Cells($lnRow, 11)->Font->{Italic} = TRUE;
  $lnRow++;
  my $lnLastRow = $loXlw->WorkSheets('KeyWord')->Cells(1,1)->End(xlDown)->{Row};
  $intLoopRow = 1;
  while ($intLoopRow < $lnLastRow) {
    # Loop through each saved cell row
    $lnCol = 11;
    $intLoopCol = 1;
    while ($intLoopCol < 6) {
      $loXls->Cells($lnRow, $lnCol)->{Value} =
        $loXlw->Worksheets('Keyword')->Cells($intLoopRow, $intLoopCol)->Value;
      $lnCol++;
      $intLoopCol++;
    }
    $lnRow++;
    $intLoopRow++;
  }
  print "\n" if (clDEBUG);

  # Fix Formatting
  with($loXls->Columns(1), ColumnWidth => 20, HorizontalAlignment => xlLeft);
  with($loXls->Columns(2),  NumberFormat        => '#0.0', ColumnWidth => 7,
                            HorizontalAlignment => xlRight);
  with($loXls->Columns(3),  NumberFormat        => '#0.0', ColumnWidth => 5,
                            HorizontalAlignment => xlRight);
  with($loXls->Columns(4), ColumnWidth => 8, HorizontalAlignment => xlRight);
  $loXls->Columns(5)->{ColumnWidth} = 5;
  with($loXls->Columns(6), ColumnWidth => 9, HorizontalAlignment => xlLeft);
  with($loXls->Columns(7),  NumberFormat        => '#0', ColumnWidth => 6,
                            HorizontalAlignment => xlRight);
  with($loXls->Columns(8),  NumberFormat        => '#0.0', ColumnWidth => 5,
                            HorizontalAlignment => xlRight);
  with($loXls->Columns(9), ColumnWidth => 9, HorizontalAlignment => xlRight);
  $loXls->Columns(10)->{ColumnWidth} = 5;
  with($loXls->Columns(11), ColumnWidth => 44, HorizontalAlignment => xlLeft);
  with($loXls->Columns(12), NumberFormat        => '#0', ColumnWidth => 8,
                            HorizontalAlignment => xlRight);
  with($loXls->Columns(13), NumberFormat        => '#0.00', ColumnWidth => 10,
                            HorizontalAlignment => xlRight);
  with($loXls->Columns(14), NumberFormat        => '#0', ColumnWidth => 8,
                            HorizontalAlignment => xlRight);
  with($loXls->Columns(15), NumberFormat        => '#0.00', ColumnWidth => 10,
                            HorizontalAlignment => xlRight);
  with ($loXls->PageSetup, Zoom           => Variant(VT_BOOL, 0),
                           FitToPagesTall => 1, FitToPagesWide => 1,
                           Orientation    => xlLandscape);
  $loXls->PrintOut;
}

sub Move_Sheet1
{
  my ($lcName, $lcTitle) = @_; # worksheet name, title
  my $lnLastRow = $loXlw->WorkSheets($lcName)->Cells(1,1)->End(xlDown)->{Row};

  $lnRow++;
  $loXls->Cells($lnRow, 1)->{Value} = $lcTitle;
  $loXls->Cells($lnRow, 1)->Font->{Italic} = TRUE;
  $lnRow++;
  my ($intLoopRow, $intLoopCol);
  $intLoopRow = 1;
  while ($intLoopRow < $lnLastRow) {
    # Loop through each saved cell row
    $lnCol = $intLoopCol = 1;
    while ($intLoopCol < 5) {
      $loXls->Cells($lnRow, $lnCol)->{Value} =
        $loXlw->Worksheets($lcName)->Cells($intLoopRow, $intLoopCol)->Value;
      $lnCol++;
      $intLoopCol++;
    }
    $lnRow++;
    $intLoopRow++;
  }
}

sub Move_Sheet2
{
  my ($lcName, $lcTitle) = @_; # worksheet name, title
  my $lnLastRow = $loXlw->WorkSheets($lcName)->Cells(1,1)->End(xlDown)->{Row};

  $lnRow++;
  $loXls->Cells($lnRow, 6)->{Value} = $lcTitle;
  $loXls->Cells($lnRow, 6)->Font->{Italic} = TRUE;
  $lnRow++;
  my ($intLoopRow, $intLoopCol);
  $intLoopRow = 1;
  while ($intLoopRow < $lnLastRow) {
    # Loop through each saved cell row
    $lnCol = 6;
    $intLoopCol = 1;
    while ($intLoopCol < 5) {
      $loXls->Cells($lnRow, $lnCol)->{Value} =
        $loXlw->Worksheets($lcName)->Cells($intLoopRow, $intLoopCol)->Value;
      $loXls->Cells($lnRow, $lnCol)->Font->{Bold} = TRUE if ($lnCol == 6);
      $lnCol++;
      $intLoopCol++;
    }
    $lnRow++;
    $intLoopRow++;
  }
}

format STDOUT_TOP =
                             Monthxls Debug Output

Label                                              Count Percent  NSI    95% CI

.
format STDOUT =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>> @>>>>>> @>>> @>>>>>>>>
$lclabel, $lncount, $lnpercent, $lnnsi, $lcci

.
.
'************ Code End **********************