Option Explicit
Option Base 0

Private Sub Exchange()
    On Error GoTo ErrHandler:
    Dim i As Long
    Dim S As String
        
    For i = 2 To ＸＸＸ
        S = S & "BEGIN:VCARD" & vbCrLf
        S = S & "VERSION:2.1" & vbCrLf
        S = S & "N:" & Trim(Range("C" & i).Cells) & ";" & vbCrLf
        S = S & "FN:" & Trim(Range("C" & i).Cells) & vbCrLf
        S = S & "ORG:" & ";" & vbCrLf
        S = S & "TEL;WORK;VOICE;" & vbCrLf
        S = S & "TEL;WORK;FAX:0" & Trim(Range("B" & i).Cells) & vbCrLf
        S = S & "ADR;WORK:;;;;;" & vbCrLf
        S = S & "EMAIL:" & vbCrLf
        S = S & "END:VCARD" & vbCrLf
    Next i
    
    Dim intFileno As Integer
    intFileno = FreeFile
    Open "C:\ファイル名.vcf" For Output As #intFileno
        Print #intFileno, S
    Close #intFileno
    
    Stop
    
    Exit Sub
    
    
    
ErrHandler:
    MsgBox Err.Number & " " & Err.Description
    Err.Clear
    Exit Sub
End Sub