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