手机通讯录导入工具

在写文章之前我想先说一句，希望尊重别人的劳动成果，转载或者抄袭后在末尾加上原文的链接是对作者的尊重，也是鼓励作者再接再厉发帖的动力。

现在的手机五花八门，手机系统也多种多样，联系人的导入导出成了问题。为了自己，也为了身边的朋友，花了2天时间用VB做了一个小工具，大致原理如下：

不管什么系统安卓，windows，塞班，还是国产（爱疯由于没那个资金投入没做测试）都是支持国际通用的vcf格式，所以只需要将你的联系人做成这种格式就可以在很多手机上通用，VCF本身支持很多参数，以下是一个标准的VCF文件内容

BEGIN:VCARD

VERSION:3.0

N:Lastname;Firstname;;;

FN:Fullname

NICKNAME:Alias

TEL;CELL;VOICE:PrimaryCell

TEL;CELL;VOICE:SecondaryCell

TEL;WORK;VOICE:WorkNum1

TEL;WORK;VOICE:WorkNum2

TEL;HOME;VOICE:HomeNum1

TEL;HOME;VOICE:HomeNum2

TEL;HOME;VOICE:RadioNum

TEL;WORK;FAX:WorkFax

TEL;HOME;FAX:HomeFax

TEL;TYPE=ISDN:ISDNNum

EMAIL;PREF;INTERNET:Email1

EMAIL;INTERNET:Email2

EMAIL;INTERNET:Email3

URL:Website

ORG:Organization

TITLE:Grade

BDAY:Birthday

ADR;TYPE=WORK;CHARSET=UTF-8:WorkStreet3;WorkStreet2;WorkStreet1;WorkCity;WorkProvince;WorkPostalcode;WorkState

ADR;TYPE=HOME;CHARSET=UTF-8:HomeStreet3;HomeStreet2;HomeStreet1;HomeCity;HomeProvince;HomePostalcode;HomeState

END:VCARD

语法很简单，根据英文简写就能猜到是什么东东。

只需要在上面的内容中输入自己联系人信息就可以了，但是一个个输入工作量太大也不太现实，所以就想到了做一个小脚本从Excel表格中一个个去“拿”数据，并且自动做成一个个vCards文件将这些文件拷贝到手机卡就可以导入了，非安卓手机必须一个个导入，安卓可以支持合并的联系人文件导入（批量导入），并且安卓系统支持VCF LABEL字段，所以整个程序设计起来就分为了安卓与非安卓两个方案。

实现过程：

1.数据源：就一个Excel表格，第一次可能需要自己花些时间将自己的联系人输入到程序指定的Excel中。

2.VCF模板

通过复制VCF标准模板，程序将读取到得数据替换模板的内容，最终保存为VCF联系人。

3.读取Excel数据并制成VCF的脚本

Const ForReading=1

Const ForWriting=2

Const ForAppending=8

Const OverwriteExisting = True

Const DeleteReadOnly = True

Varsystem = UCase(InputBox("请选择你的手机系统." & VbCrLf & "1.Android." & VbCrLf & "2.Other."))

If Varsystem = "" then

wscript.quit

End If

If Not IsNumeric(Varsystem) then

wscript.echo "你的输入有误"

If Varsystem >=3 then

wscript.echo "请输入数字1-2"

Select Case Varsystem

Case 1

strStatus = "Android"

Case 2

strStatus = "Other"

End Select

'Define VcfFolder Path

StrVcfFolder = "vCards"

Set objFSO = CreateObject("Scripting.FileSystemObject")

If not objFSO.FolderExists(StrVcfFolder) Then

Set objFolder = objFSO.CreateFolder(StrVcfFolder)

'Define data and path

Set objShell = CreateObject("Wscript.Shell")

strCurPath = objShell.CurrentDirectory

strDataPath = strCurPath & "\Data"

strxlsfile = strDataPath & "\Contact.xls"

strTempPath = strCurPath & "\templet"

strTempfile = strTempPath & "\" & strStatus & ".vcf"

stroldvcfs = strCurPath & "\vCards\*.*"

'Delete old vcf files

objFSO.DeleteFile(stroldvcfs), DeleteReadOnly

'locate source data file

Set objExcel = CreateObject("Excel.Application")

Set objWorkbook = objExcel.Workbooks.Open(strxlsfile)

Set objWorksheet = objWorkbook.Worksheets(1)

Dim i, count

i = 3

count = 0

Do Until objExcel.Cells(i, 1).Value = ""

strFullname = objExcel.Cells(i, 1).Value

strLastname = objExcel.Cells(i, 2).Value

strFirstname = objExcel.Cells(i, 3).Value

strAlias = objExcel.Cells(i, 4).Value

strPrimaryCell = objExcel.Cells(i, 5).Value

strSecondaryCell = objExcel.Cells(i, 6).Value

strWorkNum1 = objExcel.Cells(i, 7).Value

strWorkNum2 = objExcel.Cells(i, 8).Value

strWorkFax = objExcel.Cells(i, 9).Value

strHomeNum1 = objExcel.Cells(i, 10).Value

strHomeNum2 = objExcel.Cells(i, 11).Value

strHomeFax = objExcel.Cells(i, 12).Value

strRadioNum = objExcel.Cells(i, 13).Value

strISDNNum = objExcel.Cells(i, 14).Value

strEmail1 = objExcel.Cells(i, 15).Value

strEmail2 = objExcel.Cells(i, 16).Value

strEmail3 = objExcel.Cells(i, 17).Value

strWebsite = objExcel.Cells(i, 18).Value

strOrganization = objExcel.Cells(i, 19).Value

strGrade = objExcel.Cells(i, 20).Value

strQQnum = objExcel.Cells(i, 21).Value

strMSNum = objExcel.Cells(i, 22).Value

strGoogletalk = objExcel.Cells(i, 23).Value

strBirthday = objExcel.Cells(i, 24).Value

strWorkStreet3 = objExcel.Cells(i, 25).Value

strWorkStreet2 = objExcel.Cells(i, 26).Value

strWorkStreet1 = objExcel.Cells(i, 27).Value

strWorkCity = objExcel.Cells(i, 28).Value

strWorkProvince = objExcel.Cells(i, 29).Value

strWorkPostalcode = objExcel.Cells(i, 30).Value

strWorkState = objExcel.Cells(i, 31).Value

strHomeStreet3 = objExcel.Cells(i, 32).Value

strHomeStreet2 = objExcel.Cells(i, 33).Value

strHomeStreet1 = objExcel.Cells(i, 34).Value

strHomeCity = objExcel.Cells(i, 35).Value

strHomeProvince = objExcel.Cells(i, 36).Value

strHomePostalcode = objExcel.Cells(i, 37).Value

strHomeState = objExcel.Cells(i, 38).Value

'copy from templet.vcf

strFilename = objExcel.Cells(i, 1).Value & ".vcf"

strDstPathfile = strCurPath & "\" & StrVcfFolder & "\" & strFilename

objFSO.CopyFile strTempfile, strDstPathfile, OverwriteExisting

'=========================================================1

Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)

strText = objFile.ReadAll

objFile.Close

strNewText = Replace(strText, "Fullname", strFullname)

Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)

objFile.WriteLine strNewText

'=========================================================2

strNewText = Replace(strText, "Lastname", strLastname)

'=========================================================3

strNewText = Replace(strText, "Firstname", strFirstname)

'=========================================================4

strNewText = Replace(strText, "Alias", strAlias)

'=========================================================5

strNewText = Replace(strText, "PrimaryCell", strPrimaryCell)

'=========================================================6

strNewText = Replace(strText, "SecondaryCell", strSecondaryCell)

'=========================================================7

strNewText = Replace(strText, "WorkNum1", strWorkNum1)

'=========================================================8

strNewText = Replace(strText, "WorkNum2", strWorkNum2)

'=========================================================9

strNewText = Replace(strText, "WorkFax", strWorkFax)

'========================================================10

strNewText = Replace(strText, "HomeNum1", strHomeNum1)

'========================================================11

strNewText = Replace(strText, "HomeNum2", strHomeNum2)

'========================================================12

strNewText = Replace(strText, "HomeFax", strHomeFax)

'========================================================13

strNewText = Replace(strText, "RadioNum", strRadioNum)

'========================================================14

strNewText = Replace(strText, "ISDNNum", strISDNNum)

'========================================================15

strNewText = Replace(strText, "Email1", strEmail1)

'========================================================16

strNewText = Replace(strText, "Email2", strEmail2)

'========================================================17

strNewText = Replace(strText, "Email3", strEmail3)

'========================================================18

strNewText = Replace(strText, "Website", strWebsite)

'========================================================19

strNewText = Replace(strText, "Organization", strOrganization)

'========================================================20

strNewText = Replace(strText, "Grade", strGrade)

'========================================================21

strNewText = Replace(strText, "QQnum", strQQnum)

'========================================================22

strNewText = Replace(strText, "MSNum", strMSNum)

'========================================================23

strNewText = Replace(strText, "Googletalk", strGoogletalk)

'========================================================24

strNewText = Replace(strText, "Birthday", strBirthday)

'========================================================25

strNewText = Replace(strText, "WorkStreet3", strWorkStreet3)

'========================================================26

strNewText = Replace(strText, "WorkStreet2", strWorkStreet2)

'========================================================27

strNewText = Replace(strText, "WorkStreet1", strWorkStreet1)

'========================================================28

strNewText = Replace(strText, "WorkCity", strWorkCity)

'========================================================29

strNewText = Replace(strText, "WorkProvince", strWorkProvince)

'========================================================30

strNewText = Replace(strText, "WorkPostalcode", strWorkPostalcode)

'========================================================31

strNewText = Replace(strText, "WorkState", strWorkState)

'========================================================32

strNewText = Replace(strText, "HomeStreet3", strHomeStreet3)

'========================================================33

strNewText = Replace(strText, "HomeStreet2", strHomeStreet2)

'========================================================34

strNewText = Replace(strText, "HomeStreet1", strHomeStreet1)

'========================================================35

strNewText = Replace(strText, "HomeCity", strHomeCity)

'========================================================36

strNewText = Replace(strText, "HomeProvince", strHomeProvince)

'========================================================37

strNewText = Replace(strText, "HomePostalcode", strHomePostalcode)

'========================================================38

strNewText = Replace(strText, "HomeState", strHomeState)

ii = i + 1

countcount = count + 1

Loop

objExcel.Quit

Wscript.echo "共导入" & count & "个联系人"

到此，单个VCF联系人就制作完毕了，拷贝到手机就可以导入了。

4.合并单个联系人为一个

因为安卓系统支持合并的多联系人VCF文件，所以另写了一个脚本合并所有的联系人。

strVfolder = strCurPath & "\vCards"

stroutfile = strCurPath & "\contacts.vcf"

strcmd = "copy /B " & strVfolder & "\*.vcf " & stroutfile

objShell.Run("%comspec% /c" & strcmd)

wscript.sleep 2000

wscript.echo "联系人合成完毕!"

5.合并后发现内容中有很多空行和没有实际数值的行，写了个优化脚本，删除多余的空白行和没有值的行。

思路：先将无值行替换成空行再移除空行比较简单。

On Error Resume Next

'Replace all useless line to blank.

Set objFile = objFSO.OpenTextFile("contacts.vcf", ForReading)

Do Until objFile.AtEndOfStream

strLine = objFile.Readline

strLine = Trim(strLine)

strRline = Right(strLine, 1)

If strRline = ":" Then

strnewline = " "

Else

strnewline = strLine

End if

strNewTextstrNewText = strNewText & strnewline & vbCrLf

Set objFile = objFSO.OpenTextFile("contacts.vcf", ForWriting)

objFile.Write strNewText

'Delete all blank line

If Len(strLine) > 0 Then

strNewContentsstrNewContents = strNewContents & strLine & vbCrLf

End If

objFile.Write strNewContents

wscript.echo "优化完毕!"

优化后的vcf就可以导入安卓系统或者上传到google通讯录了。

本文转自yangye1985 51CTO博客，原文链接：http://blog.51cto.com/yangye/728062，如需转载请自行联系原作者

手机通讯录导入工具

继续阅读

Android项目的依赖关系解析

Android Studio 安装具体步骤

三年开发经验，从小厂离职后，我凭什么拿到了阿里、腾讯、今日头条的offer我为什么离职准备面试刷题简历

Android网络编程之使用HttpClient批量上传文件（一）1.预备知识：2.通过HttpCient上传文件程序运行效果图：3.完成项目代码：

Android网络编程之使用HttpClient批量上传文件（二）AsyncTask+HttpClient并实现上传进度监听 Android网络编程之使用HttpClient批量上传文件（二）AsyncTask+HttpClient并实现上传进度监听

android 使用shape自定义圆角矩形

为什么不再使用 Android MVVM

方法数超了65535 无法安装的解决方案

android调用系统相机拍摄获取照片的两种方法

Android调用系统拍照获取图片问题

Android Studio中Make Project、Clean Project、Rebuild Project 的作用

新买的便携式蓝牙标签打印机集成测试起因分析提供的SDK开始使用蓝牙测试工具进行测试打印打印乱码分析JAVA中Unicode转ANCI工具链接

Android面试题——5.常见面试官提问Android面试题①

Android常用工具类简介目录

android常用工具类转载自：http://www.trinea.cn/android/android-common-utils/Android常用工具类

Android电视机（机顶盒）初次开发的一些经验分享