perl处理Excel通讯录，得到vcard的vcf通讯录，分享一下

xiaomm250

1. #用perl处理Excel通讯录(从Excel复制到input.txt),最后形成vCard的
   
2. #vcf通讯录不乱码,传到手机QQ上,然后打开就可以导入通讯录联系人
   
3. #2019年5月6日
   
4. ###############################################################
   
5. #input.txt文件格式如下:
   
6. #第一列姓名,第二列工作单位,第三列手机号,中间空格分开
   
7. #或者第一列姓名,第二列手机号,中间空格分开
   
8. ###############################################################
   
9. #比如输入文件内容如下：
   
10. #张三 家里蹲公司 12345678901
    
11. #李四 1234567
    
12. ###############################################################
    
13. #输出内容如下:
    
14. #BEGIN:VCARD
    
15. #VERSION:2.1
    
16. #N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;=E5=BC=A0=E4=B8=89;;;
    
17. #FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E5=BC=A0=E4=B8=89
    
18. #TEL;CELL:12345678901
    
19. #ORG;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E5=AE=B6=E9=87=8C=E8=B9=B2=E5=85=AC=E5=8F=B8
    
20. #END:VCARD
    
21. #BEGIN:VCARD
    
22. #VERSION:2.1
    
23. #N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;=E6=9D=8E=E5=9B=9B;;;
    
24. #FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=E6=9D=8E=E5=9B=9B
    
25. #TEL;CELL:1234567
    
26. #END:VCARD
    
27. ###############################################################
    
28. #检验网站:记得选择utf-8,而不是GB2312
    
29. #web.chacuo.net/charsetquotedprintable
    
30. ###############################################################
    
31. use MIME::QuotedPrint;
    
32. use Encode;
    
33. use strict;use warnings;use diagnostics;
    
34. #先打开读取文件内容,保存到数组里面
    
35. open(FHa,"<input.txt");#读取通讯录
    
36. my @data=<FHa>;
    
37. close(FHa);
    
38. #输出结果
    
39. open(FHb,">output_address.vcf");#输出通讯录
    
40. foreach my $line (@data)
    
41. {
    
42.     chomp($line);
    
43.     if($line=~m/^\s*(\S+)\s+(\S+)\s+(\d{7,12})\s*$/)#姓名,工作单位,手机号
    
44.     {
    
45.         my $name=gbbm($1);#姓名编码
    
46.         my $corp=gbbm($2);#工作单位
    
47.         print FHb "BEGIN:VCARD\n";
    
48.         print FHb "VERSION:2.1\n";
    
49.         print FHb "N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;$name;;;\n";
    
50.         print FHb "FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:$name\n";#姓名
    
51.         print FHb "TEL;CELL:$3\n";#手机号
    
52.         print FHb "ORG;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:$corp\n";#工作单位
    
53.         print FHb "END:VCARD\n";
    
54.     }elsif($line=~m/^\s*(\S+)\s+(\d{7,12})\s*$/)#姓名,手机号
    
55.     {
    
56.         my $name=gbbm($1);#姓名编码
    
57.         print FHb "BEGIN:VCARD\n";
    
58.         print FHb "VERSION:2.1\n";
    
59.         print FHb "N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;$name;;;\n";
    
60.         print FHb "FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:$name\n";#姓名
    
61.         print FHb "TEL;CELL:$2\n";#手机号
    
62.         print FHb "END:VCARD\n";
    
63.     }else
    
64.     {
    
65.         print FHb "$line error88888888\n";#8个8,输出错误行的内容以及标志,方便搜索删除
    
66.     }
    
67. }
    
68. close(FHb);
    
69. 
    
70. #子函数gbbm(改变编码),改变字符串编码,由于Windows上基本都是cp936复制粘贴,
    
71. #所以先把编码从cp936转化成utf-8,然后再转化成QUOTED-PRINTABLE
    
72. sub gbbm{
    
73.     my($str)=shift(@_);
    
74.     $str=encode("utf8",decode("cp936",$str));#编码转换
    
75.     $str=encode_qp($str);#QUOTED-PRINTABLE
    
76.     chomp($str);#如果有回车就删除掉
    
77.     $str=~s/=$//g;#不知道末尾为什么多一个=号,多了就删除掉
    
78.     return $str;
    
79. }
    

复制代码