简体   繁体   中英

Perl How to merge two or more excel files in one (multiple worksheets)?

I need to merge a few excel file into one, multiple sheets. I do not care too much about the sheet name on the new file.

I do not have Excel on the computer I plan to run this. so I cannot use Win32 OLE. I attempted to run this code https://sites.google.com/site/mergingxlsfiles/ but it is not working, I get a new empty excel file.

I attempt to run http://www.perlmonks.org/?node_id=743574 but I only obtained one of the file in the new excel file.

My input excel files have some french characters (é for eg) I believe these are cp1252.

Code used :

    #!/usr/bin/perl -w
    use strict;
    use Spreadsheet::ParseExcel;
    use Spreadsheet::WriteExcel;
    use File::Glob qw(bsd_glob);
    use Getopt::Long;
    use POSIX qw(strftime);

    GetOptions(
        'output|o=s' => \my $outfile,
        'strftime|t' => \my $do_strftime,
    ) or die;

    if ($do_strftime) {
        $outfile = strftime $outfile, localtime;
    };

    my $output = Spreadsheet::WriteExcel->new($outfile)
        or die "Couldn't create '$outfile': $!";

    for (@ARGV) {
        my ($filename,$sheetname,$targetname);
        my @files;
        if (m!^(.*\.xls):(.*?)(?::([\w ]+))$!) {
            ($filename,$sheetname,$targetname) = ($1,qr($2),$3);
            warn $filename;
            if ($do_strftime) {
                $filename = strftime $filename, localtime;
            };
            @files = glob $filename;
        } else {
            ($filename,$sheetname,$targetname) = ($_,qr(.*),undef);
            if ($do_strftime) {
                $filename = strftime $filename, localtime;
            };
            push @files, glob $filename;
        };

        for my $f (@files) {
            my $excel = Spreadsheet::ParseExcel::Workbook->Parse($f);
            foreach my $sheet (@{$excel->{Worksheet}}) {
                if ($sheet->{Name} !~ /$sheetname/) {
                    warn "Skipping '" . $sheet->{Name} . "' (/$sheetname/)";
                    next;
                };
                $targetname ||= $sheet->{Name};
                #warn sprintf "Copying %s to %s\n", $sheet->{Name}, $targetname;

                my $s = $output->add_worksheet($targetname);
                $sheet->{MaxRow} ||= $sheet->{MinRow};
                foreach my $row ($sheet->{MinRow} .. $sheet->{MaxRow}) {
                    my @rowdata = map {
                        $sheet->{Cells}->[$row]->[$_]->{Val};
                    } $sheet->{MinCol} ..  $sheet->{MaxCol};
                    $s->write($row,0,\@rowdata);
                }
            }
        };
    };

    $output->close;

I have 2 excel files named: 2.xls (only 1 sheet named 2 in it), 3.xls (only 1 sheet named 3)

I launched the script as this:

xlsmerge.pl -s -o results-%Y%m%d.xls 2.xls:2 3.xls:3

Results: results-20121024.xls empty nothing in it.

Then I tried

xlsmerge.pl -s -o results-%Y%m%d.xls 2.xls 3.xls 

And it worked. I am not sure why is it failing while adding the Sheetname

It appears that there is a bug in this line of the script:

if (m!^(.*\.xls):(.*?)(?::([\w ]+))$!) {
     ($filename,$sheetname,$targetname) = ($1,qr($2),$3);
     ...

It looks to me like the goal of that line is to allow arguments either in the form

spreadsheet.xls:source_worksheet

or in another form allowing the name of the target sheet to be specified:

spreadsheet.xls:source_worksheet:target_worksheet

The last grouping appears intended to capture that last, optional argument: (?::([\\w ]+)) . The only problem is, this grouping was not made optional. Thus, when you only specify the source sheet and not the target, the regex fails to match and it falls to the backup behavior, which is to treat the whole argument as the filename. But this fails, too, because you don't have a file called 2.xls:2 .

The solution would be to introduce the ? modifier after the last group in the regex to make it optional:

if (m!^(.*\.xls):(.*?)(?::([\w ]+))?$!) {
     ($filename,$sheetname,$targetname) = ($1,qr($2),$3);
     ...

Of course, that may not be the only problem. If the script was posted with an error, there could be other errors, too. I don't have Perl available to test it at the moment.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM