手機通訊錄導入工具

在寫文章之前我想先說一句，希望尊重別人的勞動成果，轉載或者抄襲後在末尾加上原文的鏈接是對作者的尊重，也是鼓勵作者再接再厲發帖的動力。

 

現在的手機五花八門，手機系統也多種多樣，聯繫人的導入導出成了問題。爲了自己，也爲了身邊的朋友，花了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 "你的輸入有誤"
wscript.quit
End If

If Varsystem >=3 then
wscript.echo "請輸入數字1-2"
wscript.quit
End If

    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)
End If

'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
Set objFSO = CreateObject("Scripting.FileSystemObject")
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
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile strTempfile, strDstPathfile, OverwriteExisting

'=========================================================1
Set objFSO = CreateObject("Scripting.FileSystemObject")
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
objFile.Close

'=========================================================2
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Lastname", strLastname)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'=========================================================3
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Firstname", strFirstname)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'=========================================================4
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Alias", strAlias)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'=========================================================5
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "PrimaryCell", strPrimaryCell)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'=========================================================6
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "SecondaryCell", strSecondaryCell)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'=========================================================7
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkNum1", strWorkNum1)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'=========================================================8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkNum2", strWorkNum2)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'=========================================================9
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkFax", strWorkFax)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================10
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeNum1", strHomeNum1)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================11
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeNum2", strHomeNum2)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================12
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeFax", strHomeFax)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================13
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "RadioNum", strRadioNum)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================14
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "ISDNNum", strISDNNum)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================15
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Email1", strEmail1)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================16
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Email2", strEmail2)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================17
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Email3", strEmail3)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================18
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Website", strWebsite)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================19
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Organization", strOrganization)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================20
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Grade", strGrade)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================21
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "QQnum", strQQnum)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================22
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "MSNum", strMSNum)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================23
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Googletalk", strGoogletalk)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================24
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "Birthday", strBirthday)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================25
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkStreet3", strWorkStreet3)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================26
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkStreet2", strWorkStreet2)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================27
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkStreet1", strWorkStreet1)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================28
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkCity", strWorkCity)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================29
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkProvince", strWorkProvince)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================30
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkPostalcode", strWorkPostalcode)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================31
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "WorkState", strWorkState)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================32
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeStreet3", strHomeStreet3)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================33
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeStreet2", strHomeStreet2)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================34
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeStreet1", strHomeStreet1)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================35
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeCity", strHomeCity)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================36
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeProvince", strHomeProvince)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================37
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomePostalcode", strHomePostalcode)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

'========================================================38
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "HomeState", strHomeState)
Set objFile = objFSO.OpenTextFile(strDstPathfile, ForWriting)
objFile.WriteLine strNewText
objFile.Close

ii = i + 1
countcount = count + 1
Loop

objExcel.Quit
Wscript.echo "共導入" & count & "個聯繫人"

到此，單個VCF聯繫人就製作完畢了，拷貝到手機就可以導入了。

4.合併單個聯繫人爲一個

因爲安卓系統支持合併的多聯繫人VCF文件，所以另寫了一個腳本合併所有的聯繫人。

Set objShell = CreateObject("Wscript.Shell")
strCurPath = objShell.CurrentDirectory
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

Const ForReading=1
Const ForWriting=2

'Replace all useless line to blank.
Set objFSO = CreateObject("Scripting.FileSystemObject")
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
Loop

objFile.Close

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

'Delete all blank line
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("contacts.vcf", ForReading)

Do Until objFile.AtEndOfStream
    strLine = objFile.Readline
    strLine = Trim(strLine)
    If Len(strLine) > 0 Then
        strNewContentsstrNewContents = strNewContents & strLine & vbCrLf
    End If
Loop

objFile.Close

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

wscript.echo "優化完畢!"

優化後的vcf就可以導入安卓系統或者上傳到google通訊錄了。

 

PS：附件爲整個程序文件（含使用說明和另兩個驚喜程序^_^）

做的不好別拍磚，支持的留個腳印。

你的支持是我最大的動力。