Vcard Düzenlemesi

1 2 3

checkbox eklenti arasında hangisi acaba sembol olarak

Onay Kutusu diye bakın, gözünüzü seveyim daha checkbox ne onu bilmiyorsunuz

Sn atoykan kaç adet onay kutusu eklemeliyim
Bir de ne yapmam gerektiğinde biraz daha açıklayıcı bilgi verebilir misin selamlar

1 tane Sayın @access acemisi
Checkbox değeri 0 ise yani seçili değilse combobox seçimlerinize göre işlem yapsın aksi halde belirttiğim gibi grup tablonuzun ilk ve son idsini for - next döngüsünde i değişkeni için kullanıp (i=ilk_id to son_id gibi) her seçeneğe göre döngüyle vcardınızı oluşturun.

Ve lütfen sormadan önce bu konuları tek tek bir daha araştırın, checkbox nedir, döngü nedir, nasıl kullanılır vs. 2011'den beri konularınıza bakıyorum, bu kadar basit bir işlemi çözmek için gereken bilgiye çoktan sahip olmanız gerekirken sadece verilen cevaplar üzerinden kopyala yapıştır dışında bir gelişim göstermemişsiniz anlaşılan.

(24/01/2024, 17:51)atoykan yazdı: 1 tane

bir tane onay kodo ekledim. Sonra ne yapacağımı bilmiyorum. Olmazsa bu konuyu kapatalım.

Formunuza bir checkbox ekleyin ve chk_allgroups olarak adlandırın.
cmd_tumkayitlar_iki_click kodunuzu aşağıdakiyle değiştirin.

Kod:
Private Sub cmd_tumkayitlar_iki_Click()

If Me.chk_allgroups = 0 Then

    GoTo vcardpublish

Else

    Dim RecordFound As Boolean

    RecordFound = False

    For i = 1 To 7

        Me.secenek = i

vcardpublish:

        Dim objStream

        Dim VcardAdi, FileName, File, encode As String

        Dim rst As DAO.Recordset

        Dim image_bin() As Byte

        Dim GSayi As Integer

        VcardAdi = Format(Date, "ddmmyyyy") & "TumKayitlar.vcf"

        FileName = CurrentProject.path & "\" & VcardAdi

        Set objStream = CreateObject("ADODB.Stream")

        objStream.Charset = "utf-8"

        objStream.Open

        GSorgum = "SELECT tbl_kisiler.secenek_bir, * FROM tbl_kisiler WHERE (((tbl_kisiler.secenek_bir)='" & Me.secenek & "'));"

        Set rst = CurrentDb.OpenRecordset(GSorgum)

        If Not rst.EOF Then

            rst.MoveFirst

            Me.etk_ilerle.Visible = True

            GSayi = 0

            Do Until rst.EOF

                objStream.WriteText "BEGIN:VCARD" & vbCrLf

                objStream.WriteText "VERSION:4.0" & vbCrLf

                objStream.WriteText "N:" & rst!soyadi & ";" & rst!adisoyadi & ";" & rst!ikinciadi & ";" & rst!unvani & vbCrLf

                objStream.WriteText "FN:" & rst!adisoyadi & " " & rst!soyadi & vbCrLf

                objStream.WriteText "ORG:" & rst!sirketbilgisi & vbCrLf

                objStream.WriteText "TITLE:" & rst!isunvani & vbCrLf

                File = CurrentProject.path & "\resimler\" & rst!fotograf

                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;TYPE=JPEG;ENCODING=B:" & encode & vbCrLf

                End If

                objStream.WriteText "TEL;WORK;VOICE:" & rst!istelefonu & vbCrLf

                objStream.WriteText "TEL;HOME;VOICE:" & rst!evtelefonu & vbCrLf

                objStream.WriteText "TEL;CELL;VOICE:" & rst!ceptelefonu & vbCrLf

                objStream.WriteText "ADR;WORK:" & rst!isadresi & ";" & rst!issehir & ";" & rst!ispostakodu & ";" & rst!isulke & vbCrLf

                objStream.WriteText "ADR;HOME:" & rst!evadresi & ";" & rst!sehir & ";" & rst!evpostakodu & ";" & rst!evulke & vbCrLf

                objStream.WriteText "CATEGORIES:" & DLookup("id_il", "il", "[id_il]= " & Nz(rst!sehir, 0)) & vbCrLf

                objStream.WriteText "X-MS-OL-DEFAULT-POSTAL-ADDRESS:1" & vbCrLf

                objStream.WriteText "EMAIL;PREF;INTERNET:" & rst!epostaadresi & vbCrLf

                objStream.WriteText "URL;WORK:" & rst!websayfasi & vbCrLf

                objStream.WriteText "NOTE:" & rst!notbir & vbCrLf

                objStream.WriteText "NOTE:" & rst!notiki & vbCrLf

                objStream.WriteText "NOTE:" & rst!notuc & vbCrLf

                objStream.WriteText "REV:" & Format(Date, "yyyymmdd") & "T" & Format(Now(), "hhnnss") & "Z" & vbCrLf

                objStream.WriteText "CATEGORIES:" & DLookup("grupadi", "grup", "[id_grup]= " & Nz(rst!secenek_bir, 0)) & vbCrLf

                objStream.WriteText "END:VCARD" & vbCrLf

                Me.etk_ilerle.Caption = rst!adisoyadi & " " & rst!soyadi

                GSayi = GSayi + 1

                rst.MoveNext

            Loop

            Me.etk_ilerle.Visible = False

            objStream.SaveToFile FileName, 2

            Me.etk_ilerle.Visible = False

            MsgBox (GSayi & " adet veri " & VcardAdi & " isimli dosyaya kaydedildi")

            rst.Close

            objStream.Close

        End If

    Next i

    If Not RecordFound Then

    MsgBox UCase(DLookup("grupadi", "grup", "id_grup=" & Me.secenek.Value)) & _

    "  grubu için kayıt bulunamamıştır!", vbInformation + vbOKOnly, "Bulunmayan Kayıt"

    End If

End If

End Sub

kodunuzda gerekli for - next döngüsü ile tüm gruplar için vcard oluşturma işlemi tanımlanmış durumdadır (sadece checkbox tikini açmanız yeterlidir seçeneklerden grup seçmeye gerek yoktur) , ayrıca kodunuzda recordsette kayıt yoksa hata verir buna ilişkin denetim de yoktu, onu da ekledim; hangi grupta kayıt oluşturulamadı uyarı verir.

Sizin konularınıza şahsen verdiğim son cevaptır, sadece ilgilenen başka insanlar fayda sağlasınlar diye kodu düzenledim. Sizin amacınız öğrenmek falan değil işinizi gördürmek; bu sebeple bir daha herhangi bir sorunuza şahsen ben cevap vermeyeceğim, bilginiz olsun.

1 2 3