Private Sub Yeni_Click()
Dim objStream
Dim VcardAdi, FileName, File, encode As String
Dim rst As DAO.Recordset
Dim image_bin() As Byte
Dim Kez As Long
VcardAdi = Format(Date, "ddmmyyyy") & "TumKayitlar.vcf"
FileName = CurrentProject.path & "\" & VcardAdi
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
For Kez = 0 To 1
GSorgum = "SELECT * FROM tbl_kisiler WHERE not isnull(" & IIf(Kez = 0, "aile", "arkadas") & ")"
Set rst = CurrentDb.OpenRecordset(GSorgum)
rst.MoveFirst
Do Until rst.EOF
    objStream.WriteText "BEGIN:VCARD" & vbCrLf
    objStream.WriteText "VERSION:3.0" & vbCrLf
     objStream.WriteText "FN:" & rst!adisoyadi & " " & rst!soyadi & vbCrLf
    objStream.WriteText "N:" & rst!soyadi & ";" & rst!adisoyadi & ";" & rst!ikinciadi & ";" & rst!unvani & vbCrLf
    objStream.WriteText "EMAIL;TYPE=INTERNET;TYPE=HOME:" & rst!epostaadresi & vbCrLf
    objStream.WriteText "TEL;TYPE=HOME:" & rst!evtelefonu & vbCrLf
     objStream.WriteText "TEL;TYPE=WORK:" & rst!istelefonu & vbCrLf
    objStream.WriteText "ADR;HOME:" & rst!isadresi & " " & rst!issehir & " " & rst!ispostakodu & " " & rst!isulke & vbCrLf
    objStream.WriteText "BDAY:" & 19880415 & vbCrLf
    File = Nz(rst!fotograf, "Yok")
    If FileExists(File) = True Then
            Open File For Binary Access Read As #1
            ReDim image_bin(LOF(1) - 1)
            Get #1, , image_bin
            Close #1
            encode = Replace(EncodeBase64(image_bin), vbLf, vbCrLf & Space(1))
            objStream.WriteText "PHOTO:" & encode & vbCrLf
    End If
    objStream.WriteText "item2.Title:" & rst!isunvani & vbCrLf
    objStream.WriteText "CATEGORIES:" & DLookup(IIf(Kez = 0, "aile", "arkadas"), "[tbl_" & IIf(Kez = 0, "aile", "arkadas") & "]", "[id_" & IIf(Kez = 0, "aile", "arkadas") & "]=" & Nz(rst.Fields(IIf(Kez = 0, "aile", "arkadas")), 0)) & vbCrLf
    objStream.WriteText "END:VCARD" & vbCrLf
    rst.MoveNext
Loop
Next Kez
objStream.SaveToFile FileName, 2
rst.Close
objStream.Close
End Sub