[经验总结]Perl读取Excel数据并调用MSXML接口操作XML数据

本文主要是介绍[经验总结]Perl读取Excel数据并调用MSXML接口操作XML数据，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！

#################################################################################################################################
#  File: excel.pl
#  Desscription: Perl读取Excel文件
#  Create: Thinkhy
#  Date: 2010.05.04
#  History:
#        2010.05.04      确定转换规则
#        2010.05.05      确定技术方案（Excel、XML操作库）
#        2010.05.07      完成编码
#        2010.05.10      根据确认意见，修改：
#                                   1> 输出XML保持有序(sequence)
#
#  Q:   1. 暂只支持"绝对路径"的中文文件名? A: 暂无解决办法
#       2. 怎么确认Excel文件共有多少行？   A: 已解决,参考：http://blog.csdn.net/lanman/archive/2007/07/10/1684191.aspx
#       3. 输出XML添加GBK的编码声明?       A: 已解决，调用接口：createProcessingInstruction appendChild
#################################################################################################################################
##!/usr/local/bin/perl

use strict;

use Tie::IxHash; # 使用CPAN包 IxHash 使哈希值保持原有顺序

use Win32::OLE qw(in with);
use Win32::OLE::Const 'Microsoft Excel';

use constant MSXMLDOM => "MSXML2.DOMDOCUMENT.4.0";

$Win32::OLE::Warn = 3;      #die on errors

# 文件名中须包括绝对路径
my $filename = $ARGV[0];   # 必须用绝对路径
my $output_file = $ARGV[1]; # 可以用相对路径

die "[Usage: excel.pl inputfile outputfile]" if (!$filename);

my $excel = Win32::OLE->GetActiveObject('Excel.Application')
             ||  Win32::OLE->new('Excel.Application',   'Quit');

my $book0 = $excel->Workbooks->Open($filename);

my $sheet0 = $book0->Worksheets(1);

# 获得Excel文件的行数
# 参考： http://blog.csdn.net/lanman/archive/2007/07/10/1684191.aspx
my $row_num = $sheet0->{UsedRange}->{Rows}->{Count};

my @collection;
my @array;

# 生成
if ($row_num > 0) {
    # 生成头结点

    my $doc = Win32::OLE->new(MSXMLDOM) or die
        "Couldn't create @{[MSXMLDOM]}";

    $doc->{async} = "False";
    $doc->{validateOnParse} = "True";

    # 新建PI结点默认编码为GBK
    my $pi_node = $doc->createProcessingInstruction("xml", "version='1.0'   encoding='GBK'");
    $doc->appendChild($pi_node);  # 记得创建PI结点后要手动append到doc结点

    # 新建根结点
    my $root = $doc->createElement("root");
    $doc->appendChild($root);
    $doc->{documentElement} = $root;

    my $head = $doc->createElement("head");
    $root->appendChild($head);

    # 新建头结点
    my %head_info;
    tie (%head_info, 'Tie::IxHash');
    %head_info = (  # 哈希要用小括号包起来?
                    "class"       => "条目",
                    "identity"    => "",
                    "copyright"   => "",
                    "publishtime" => "2002-04-10",  # [TODO] 这里需要取当前时间
                    "state"       => "中国",
                    "area"        => "北京",
   );

    foreach my $key (keys %head_info) {
        my $value = $head_info{$key};
        my $node = $doc->createElement($key);
        $node->{Text} = $value;
        $head->appendChild($node);
    }

    # 新建main结点
    my $main = $doc->createElement("main");
    $root->appendChild($main);

    my @tmp_array = (1..156);
    my $cnt_item = 1;

    for (my $num = 1; $num < $row_num; $num++) {
        my $item_name =  getcell($sheet0, $num, 'A'); # 地名
        my $pinyin =  getcell($sheet0, $num, 'B');    # 拼音
        my $abbr =  getcell($sheet0, $num, 'C');      # 简称
        my $zoneid =  getcell($sheet0, $num, 'D');    # 区号
        my $zipcode =  getcell($sheet0, $num, 'E');   # 邮编
        my $author =  getcell($sheet0, $num, 'M');    # 作者

        my $writetime =  getcell($sheet0, $num, 'K'); # 时间
        $writetime =~ s//./-/ig;

        my $trace =  getcell($sheet0, $num, 'L');     # 来源

        # 首列（条目名）或拼音为空则过滤此行
        # print $item_name, $pinyin, $abbr, $zoneid, $zipcode , "/n";

        next if (!$item_name || (!$pinyin && !$abbr && !$zoneid && !$zipcode));

        # 过滤首列内容为 “地名” 的行
        next if ($item_name =~ //s*地名/s*/);

        # 新建 item 结点
        my $item = $doc->createElement("item");
        $main->appendChild($item);
        $item->setAttribute("id",$cnt_item++);
        $item->setAttribute("fatherid",0);

        my %main_info;
        tie (%main_info, 'Tie::IxHash');
        %main_info = (  # 哈希要用小括号包起来?
                        "type"      => "",
                        "name"      => $item_name,
                        "ename"     => "",
                        "spell"     => $pinyin,
                        "volume"    => "",
                        "subclass"  => "",
                        "author"    => $author,
                        "writetime" => $writetime,
                        "referitem" => $item_name,
                        "trace"     => $trace,
                        "links"     => "",
                        "elementfiles"  => "",
        );

        # 构建item下一级内容
        foreach my $key (keys %main_info) {
            my $value = $main_info{$key};
            my $node = $doc->createElement($key);
            $node->{Text} = $value;
            $item->appendChild($node);

            if ($key eq "elementfiles") {
                my $sourcetype = $doc->createElement("sourcetype");
                my $count = $doc->createElement("count");

                $node->appendChild($sourcetype);
                $node->appendChild($count);
            }
        }

        # 省级、市级元素按HOTLINK处理
        my $province =  getcell($sheet0, $num, 'I');   # 省级
        my $city =  getcell($sheet0, $num, 'J');     # 市级

        my $links = $item->selectSingleNode("links");
        $links || die "未创建links结点";

        my ($hotlink1, $hotlink2);

        # 省级元素不为空则创建HOTLINK
        if ($province) {
            my $hotlink_pro = $doc->createElement("HOTLINK");
            $hotlink_pro->{Text} = $province;

            $hotlink1 = $hotlink_pro->cloneNode(1);
            $links->appendChild($hotlink_pro);
        }

        if ($city) {
            my $hotlink_city = $doc->createElement("HOTLINK");
            $hotlink_city->{Text} = $city;

            $hotlink2 = $hotlink_city->cloneNode(1);
            $links->appendChild($hotlink_city);
        }

        my $body = $doc->createElement("body");
        $item->appendChild($body);

        my $body_cdata = $doc->createElement("body_cdata");

        my $province =  getcell($sheet0, $num, 'I');&nbs p; # 省级
        my $city =  getcell($sheet0, $num, 'J');      # 市级

        my $population = getcell($sheet0, $num, 'F'); # 人口
        my $area = getcell($sheet0, $num, 'G');       # 面积
        my $summary = getcell($sheet0, $num, 'H');    # 概况

        my %cdata_info;
        tie (%cdata_info, 'Tie::IxHash');
        %cdata_info = (
                             "简称" => "$abbr",
                             "区号" => "$zoneid",
                             "邮编" => "$zipcode",
                             "人口（万人）" => "$population",
                             "面积（平方千米）" => "$area",
                             "概况" => "$summary",
                             "省级" => "$hotlink1->{Text}",
                             "市级" => "$hotlink2->{Text}",
                         );

        # 构建CDATA内容
        foreach my $key (keys %cdata_info) {
            my $value = $cdata_info{$key};
            next if (!$value); # 值为空则忽略

            # 每个项目一行(<p>)
            my $p_node = $doc->createElement("p");
            $body_cdata->appendChild($p_node);

            # 字段名称加粗(<bold>)
            my $bold_node = $doc->createElement("bold");
            $bold_node->{Text} = $key."：";
            $p_node->appendChild($bold_node);

            if ($key eq "省级" || $key eq "市级") { # 省级、市级直接添加HOTLINK结点
                my $hotlink_node = $doc->createElement("HOTLINK");
                $hotlink_node->{Text} = $value;
                $p_node->appendChild($hotlink_node);
            }
            else {
                my $text_node = $doc->createTextNode($value);
                $p_node->appendChild($text_node);
            }
        }

        my $cdata_text = $body_cdata->{xml};
        $cdata_text =~ s/(<body_cdata>)|(<//body_cdata>)//ig;  # 清除body_cdata结点

        # 新建CDATA结点
        my $cdata_node = $doc->createCDATASection($cdata_text);

        # 将CDATA结点添加到 /root/main/item/body
        $body->appendChild($cdata_node);
    } # for

    # 保存输出XML
    my($dirpath,$basename,$extname) = ($filename =~ /^((?:.*[:])?)(.*)(/.[^.]*$)/s); # 获取文件名代码来源于basename.pm
    $output_file = $output_file ? $output_file : $basename.".xml";

    $doc->save($output_file);
    print "Excel文件".'"'.$filename.'"'."转换成功!/n输出文件：$output_file/n";
}

$book0->Close;

# 获得Excel表格中的一个元素
sub getcell {
    my($sheet, $x, $y, $cellvalue);
    ($sheet, $x, $y) = @_;

    $cellvalue = $sheet->cells($x, $y)->{'Value'};
    chomp($cellvalue); # 注意chomp的返回值为数字

    $cellvalue;
}

__END__