Excelファイル内の全シートをCSV保存するPerlスクリプト

excel2csvs.pl

#!perl
# Written by Makio Tsukaoto (tsukamoto at gmail.com)

use strict;
use warnings;
use File::Spec;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Excel';
our $VERSION = "0.01";

$| = 1;

&usage unless (@ARGV);

my @files = @ARGV;
@files = grep { -f $_ } map { (-d $_) ? glob("$_/*") : ($_) } @files;
@files = grep { /\.xlsm?$/i } @files;
@files = map { File::Spec->rel2abs($_) } @files;

&usage("Error: no xls/xlsm files found at " . join(', ', map {"'$_'"} @ARGV)) unless (@files);
printf("%d books found.\n", scalar(@files));

printf qq(launching "Excel.Application"\r);
my $excel_launched = 0;
my $excel = Win32::OLE->GetActiveObject('Excel.Application');
unless ($excel) {
	$excel = Win32::OLE->new('Excel.Application', 'Quit');
	$excel_launched = 1;
}
print qq(launching "Excel.Application" ... done.\n);

foreach my $file (@files) {
	my $rel = File::Spec->abs2rel($file);
	print qq(opening "$rel"\r);
	my $book = $excel->Workbooks->Open($file); 
	$excel->{DisplayAlerts} = 'False';
	print qq(opening "$rel ... done"\n);

	my $dir = $file;
	$dir =~ s/\.[^\.\\\/]+$//;
	mkdir($dir) unless (-d $dir);
	my $count = $book->Worksheets->{Count};
	foreach my $i (1..$count) {
		my $sheet = $book->Worksheets($i);
		my $csv   = sprintf("%s/%s.csv", $dir, $sheet->{Name});
		my $rel   = File::Spec->abs2rel($csv);
		print qq( -> saving "$rel"\r);
		$sheet->SaveAs($csv, xlCSV);
		print qq( -> saving "$rel" ... done.\n);
	}

	print qq( -> close "$rel"\r);
	$book->Close;
	print qq( -> close "$rel" ... done.\n);
}

if ($excel_launched) {
	printf qq(quiting "Excel.Application"\r);
	$excel->Quit();
	printf qq(quiting "Excel.Application" ... done.\n);
}

exit(0);

sub usage {
	my @messages = @_;
	foreach my $message (@messages) {
		$message =~ s/\s*$/\n/s;
		print $message if ($message =~ /\S/);
	}
	print "usage: excel2csv.pl [FILE or DIRECTORY] [FILE2 or DIRECTORY2] [...]\n";
	exit(1);
}