Sayın Hocam
dediğinizi uyguladım size gönderdiğim dosyada dediğimiz gerçekleşti.
Benim Kendi çalıştığım dosyada 
sarı renkli ikaz verdi bu ne anlama geliyor
saygılar

(17-04-2024, 16:32)Access Ziyaretçisi demiş ki: Sayın Hocam
dediğinizi uyguladım size gönderdiğim dosyada dediğimiz gerçekleşti.
Benim Kendi çalıştığım dosyada 
sarı renkli ikaz verdi bu ne anlama geliyor
saygılar

Tabloda ilgili alanlar olmayabilir, bazı ihtiyaçları prosedür ve işlem adımlarını takip ederek bulabilirsiniz. Özgün olan projeyi bilmediğimden, çözüm size kalmakta.

Sn Hocam
ben bir de dernek alanı ekledim.sizin gönderdğiniz kod üzerinde düzenleme yapmaya çalıştım.
Merak ettiğim şey bu etiketler de yer alacaak alanları 3 - 4  veya beş gibi çoğalta bilirmiyiz?
Ben deneme yaptım eksiklerim nelerdir,
saygılar

for sayısını 1 den 2 ye çıkarıp,

IIf(Kez = 0, "aile", IIf(Kez = 1, "arkadas", "dernek"))

olan yerleri değiştirmelisiniz.

böyle mi Sn Hocam ,Yine olmadı

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 2
GSorgum = "SELECT * FROM tbl_kisiler WHERE not isnull(" & IIf(Kez = 2, "aile", "arkadas", "dernek") & ")"
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 = 2, "aile", "arkadas","dernek"), "[tbl_" & IIf(Kez = 2, "aile", "arkadas","dernek"), ) & "]", "[id_" & IIf(Kez = 2, "aile", "arkadas","dernek"), ) & "]=" & Nz(rst.Fields(IIf(Kez = 2, "aile", "arkadas","dernek"), )), 1)) & vbCrLf
    objStream.WriteText "END:VCARD" & vbCrLf
    rst.MoveNext
Loop
Next Kez
objStream.SaveToFile FileName, 2
rst.Close
objStream.Close

End Sub

for tamam,

iif(.. eğer koşulunu incelenebilir.

IIf(Kez = 2, "aile", "arkadas", "dernek") olan yerleri IIf(Kez = 0, "aile", IIf(Kez = 1, "arkadas", "dernek")) olarak değiştirin