由于工作原因要添加挺多的联系人电话,一个个弄就太麻烦了,上网搜了一下 Excel 格式转 vcf 的教程,发现用 excel 的 vb 代码就可以完成转换,在这里贴一下代码,第一个代码是我用 ChatGPT 生成的,第二个是来自一个国外网友的代码,我用的是第二个,直接用 xlsx 格式也可以食用。代码内的 ORG;CHARSET=UTF-8:
是公司(UTF-8)、TITLE;CHARSET=UTF-8:
是职位(UTF-8)、FN:
是名字、TEL;TYPE=CELL;TYPE=PREF:
是手机号。另外,为了导入的联系人的正确性和不乱码,请将生成的vcf 用记事本打开后另存为 UTF-8 格式。
1:
Sub CreateVCFFromExcel() Dim mn_File_Num As Integer Dim mn_start_row As Long Dim mn_Output_Path As String Dim mn_Name As String Dim mn_org As String Dim mn_title As String Dim mn_Mobile_Number As String Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1" ) mn_start_row = 2 mn_File_Num = FreeFile mn_Output_Path = ThisWorkbook.Path & "\PhoneAndEmail.VCF" Open mn_Output_Path For Output As mn_File_Num Do While mn_start_row <= ws.UsedRange.Rows.Count And VBA.Trim(ws.Cells(mn_start_row, 1 ).Value) <> "" mn_Name = VBA.Trim(ws.Cells(mn_start_row, 1 ).Value) mn_org = VBA.Trim(ws.Cells(mn_start_row, 2 ).Value) mn_title = VBA.Trim(ws.Cells(mn_start_row, 3 ).Value) mn_Mobile_Number = VBA.Trim(ws.Cells(mn_start_row, 4 ).Value) Print #mn_File_Num, "BEGIN:VCARD" Print #mn_File_Num, "VERSION:3.0" Print #mn_File_Num, "FN:" & mn_Name Print #mn_File_Num, "TEL;TYPE=CELL;TYPE=PREF:" & mn_Mobile_Number Print #mn_File_Num, "ORG;CHARSET=UTF-8:" & mn_org Print #mn_File_Num, "TITLE;CHARSET=UTF-8:" & mn_title Print #mn_File_Num, "END:VCARD" mn_start_row = mn_start_row + 1 Loop Close #mn_File_Num MsgBox "The Contacts are Saved To: " & mn_Output_PathEnd Sub
2:
Sub CreateVCFFromExcel() Dim mn_File_Num As Integer Dim mn_start_row As Double mn_start_row = 2 mn_File_Num = FreeFile mn_Output_Path = ThisWorkbook.Path & "\PhoneAndEmail.VCF" Open mn_Output_Path For Output As mn_File_Num While VBA.Trim(Sheets("Sheet1" ).Cells(mn_start_row, 1 )) <> "" mn_Name = VBA.Trim(Sheets("Sheet1" ).Cells(mn_start_row, 1 )) mn_org = VBA.Trim(Sheets("Sheet1" ).Cells(mn_start_row, 2 )) mn_title = VBA.Trim(Sheets("Sheet1" ).Cells(mn_start_row, 3 )) mn_Mobile_Number = VBA.Trim(Sheets("Sheet1" ).Cells(mn_start_row, 4 )) Print #mn_File_Num, "BEGIN:VCARD" Print #mn_File_Num, "VERSION:3.0" Print #mn_File_Num, "FN:" & mn_Name Print #mn_File_Num, "TEL;TYPE=CELL;TYPE=PREF:" & mn_Mobile_Number Print #mn_File_Num, "ORG;CHARSET=UTF-8:" & mn_org Print #mn_File_Num, "TITLE;CHARSET=UTF-8:" & mn_title Print #mn_File_Num, "END:VCARD" mn_start_row = mn_start_row + 1 Wend Close #mn_File_Num MsgBox "The Contacts are Saved To: " & mn_Output_PathEnd Sub