اگر بخواهیم یکسری شماره تلفن که در اکسل وارد شده است را تبدیل به vcf نماییم مراحل زیر را انجام می دهیم
1-ستونهای اکسل را به ترتیب نام و نام خانوادگی ، شماره تماس و شماره ثابت قرار می دهیم
2-کلید کنترل + F11 را فشار می دهیم . در ادیتور ویژوال بیسیک کد را وارد می نماییم و اجرا می کنیم
فایل vcf آماده هست
Private Sub Create_VCF()
'Open a File in Specific Path in Output or Append mode
Dim FileNum As Integer
Dim iRow As Double
iRow = 2
FileNum = FreeFile
OutFilePath = "D:\OutputVCF.VCF"
Open OutFilePath For Output As FileNum
'Loop through Excel Sheet each row and write it to VCF File
While VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) <> ""
LName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
FName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))
PhNum = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3))
Print #FileNum, "BEGIN:VCARD"
Print #FileNum, "VERSION:3.0"
'Print #FileNum, "N:" & LName & ";" & FName & ";;;"
Print #FileNum, "FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:" & LName
Print #FileNum, "TEL;TYPE=WORK,VOICE;TYPE=PREF:" & FName
Print #FileNum, "TEL;TYPE=CELL;TYPE=PREF:" & PhNum
Print #FileNum, "END:VCARD"
iRow = iRow + 1
Wend
'Close The File
Close #FileNum
MsgBox "Contacts Converted to Saved To: " & OutFilePath & " "
End Sub
مدت زمان: 3 دقیقه 11 ثانیه