# Compatibility layer for applications using the old toplevel OLE.pm.
# New code should use Win32::OLE

##</code><code>##

use strict;
use warnings;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Access';

# Change a standard file path to DOS.
sub dos_path {
  local $_ = shift;
  tr{/}{\\};
  return $_;
}

my $file = 'c:/file.mdb';
my $mdb  = dos_path($file);


# Use existing instance if Access is already running
my $Access;
eval {
    $Access = Win32::OLE->GetActiveObject('Access.Application')
};
die "Access not installed" if $@;
if ( not defined $Access ) {
    $Access = Win32::OLE->new(
        'Access.Application',
#        sub { $_[0]->Quit }, # Optional destructor
    ) or die "Oops, cannot start Access";
}

$Access->{'Visible'} = 1 if $Access->{'Visible'} != 1;

if ( my $cur = $Access->CurrentDb ) {
    my $name = $cur->{'Name'};
    if ($name ne $mdb) {
        my $rc = $Access->CloseCurrentDatabase();
print "\nClosing '$name', rc=$rc\n";
        $Access->OpenCurrentDatabase($mdb);
    }
    else {
print "\nDB already loaded\n";
  }
}
else {
    $Access->OpenCurrentDatabase($mdb);
print "Fresh open\n";
}


# XXX *Something* must be opened at this point,
# or the database will close when the Perl program ends.
my $query_name = 'QArrangersComSummary';
$Access->DoCmd->OpenQuery(
    $query_name,
    acViewDesign,
    acReadOnly,
);

##</code><code>##

use strict;
use warnings;
use Win32::TieRegistry( Delimiter=>'/', ArrayValues=>0 );

my $mdb = 'c:/file.mdb';

sub find_MSAccess {
  my $key = 'HKEY_CLASSES_ROOT/Applications/MSACCESS.EXE/shell/Open/command//';
  my $pgm = $Registry->{$key} or die;
  # $pgm looks like '"C:\Program Files\Microsoft Office\OFFICE11\MSACCESS.EXE" /NOSTARTUP "%1"'
  $pgm =~ s{ \A " ( .*? MSACCESS\.EXE ) " .* \z }{$1}xi or die;
  return $pgm;
}

# Change a standard file path to DOS.
sub dos_path {
  local $_ = shift;
  tr{/}{\\};
  return $_;
}

my $access_pgm = find_MSAccess();
die "Can't run '$access_pgm'" unless -x $access_pgm;

my @cmd = (
  'start',
  $access_pgm, 
  dos_path($mdb),
);
system(@cmd)==0
  or die "System command failed!\nCommand was: '@cmd'\nError was: '$@'\n ";