20180821ImportContactFromExcel

Excel创建vcf文件，借助百度云助手导入Iphone6Plus

Sub CreateContractList()
    Set Wb = Application.ThisWorkbook
    FilePath = Wb.Path & "\班级通讯录.txt"
    Set Sht = Wb.Worksheets("处理")
    With Sht
        EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        For i = 2 To EndRow
            ThisOne = "BEGIN:VCARD" & vbCr & _
                "VERSION:3.0" & vbCr & _
                "FN: " & "Class12" & .Cells(i, 2).Value & vbCr & _
                "N:Class12;" & .Cells(i, 2).Value & ";;" & vbCr & _
                "TEL;TYPE=HOME:" & .Cells(i, "F").Value & vbCr & _
                "TEL;TYPE=WORK:" & .Cells(i, "G").Value & vbCr & _
                "ADR;TYPE=HOME:;;" & .Cells(i, "I").Value & ";广州市;广东省;;中国" & vbCr & _
                "ADR;TYPE=WORK:;;(" & .Cells(i, "C").Value & ")(" & .Cells(i, "D").Value & ")(" & _
                                              .Cells(i, "E").Value & ");广州市;广东省;;中国" & vbCr & _
                "End:VCARD"
            If FileText = "" Then
                FileText = FileText & ThisOne
            Else
                FileText = FileText & vbCr & ThisOne
            End If
        Next i
    End With
    NewTextFile FilePath, FileText
End Sub
Sub NewTextFile(ByVal FilePath As String, ByVal FileContent As String)
    Open FilePath For Output As #1
    Print #1, FileContent
    Close #1
End Sub