Skip to main content

AccessTr.neT


Vcard Düzenlemesi

access acemisi
access acemisi
12
1294

Vcard Düzenlemesi

#7
checkbox eklenti arasında hangisi acaba sembol olarak
Cevapla
#8
Onay Kutusu diye bakın, gözünüzü seveyim daha checkbox ne onu bilmiyorsunuz Icon_rolleyes
Cevapla
#9
Sn atoykan kaç adet onay kutusu eklemeliyim
Bir de ne yapmam gerektiğinde biraz daha açıklayıcı bilgi verebilir misin selamlar
Son Düzenleme: 24/01/2024, 15:02, Düzenleyen: access acemisi.
Cevapla
#10
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.
Cevapla
#11
(24/01/2024, 17:51)atoykan yazdı: 1 tane
bir tane onay kodo ekledim. Sonra ne yapacağımı bilmiyorum. Olmazsa bu konuyu kapatalım.
Cevapla
#12
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.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task