'External Properties & Functions Declaration
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal Operation As String, ByVal Filename As String, Optional ByVal Parameters As String, Optional ByVal Directory As String, Optional ByVal WindowStyle As Long = vbMinimizedFocus) As Long
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 = ThisWorkbook.Path & "\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)) <> ""
FName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
PhNum = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))

Print #FileNum, "BEGIN: VCARD"
Print #FileNum, "VERSION:3.0"
Print #FileNum, "FN:" & FName & " " & LName
Print #FileNum, "TEL;TYPE=CELL;TYPE=VOICE:" & PhNum
Print #FileNum, "END: VCARD"
iRow = iRow + 1
Wend

'Close The File
Close #FileNum
MsgBox "Contacts Converted to Saved To: " & OutFilePath & "  OK"

End Sub
