AccessTr.neT
Birleşik Değer Kutusuna Göre Vcard - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html)
+--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Birleşik Değer Kutusuna Göre Vcard (/konu-birlesik-deger-kutusuna-gore-vcard.html)

Sayfalar: 1 2 3 4 5 6

Cvp: Birleşik Değer Kutusuna Göre Vcard - access acemisi - 20/09/2018

Kod düzenlemesi için arkadaşlara teşekkür ederim.
Gmailde ,grup ismi yerine rakamlar beliriyor.Arkadaşlar 1 rakamını temsil ettiği için doğal olarak 1 rakamı gözüküyor. Bunun yerine 1 rakamı yerine, Arkadaşlar olarak gözükmesi için bir kod düzenlemesi nasıl olamalıdır.Saygılar

Cvp: Birleşik Değer Kutusuna Göre Vcard - ozanakkaya - 20/09/2018

tbl_kisiler tablosunda secenek alanına grup tablosundaki id_grup alanındaki veri kaydediliyor.

objStream.WriteText "CATEGORIES:" & rst!secenek & vbCrLf

kodu ile secenek alanındaki veri aktarıldığı için rakam olarak gözüküyor.

 dlookup ile grup tablosundaki  grupadi alanındaki veriyi aktarın.

Cvp: Birleşik Değer Kutusuna Göre Vcard - access acemisi - 20/09/2018

(20/09/2018, 12:16)ozanakkaya yazdı: dlookup ile grup tablosundaki  grupadi alanındaki veriyi aktarın.

Sn ozanaakkaya
Bunu nasıl yapabileceğimi bilmiyorum. Saygılar

Cvp: Birleşik Değer Kutusuna Göre Vcard - ozanakkaya - 20/09/2018

DLookup İşlevi


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





Set rst = CurrentDb.OpenRecordset("tbl_kisiler")

rst.MoveFirst



Me.etk_ilerle.Visible = True



GSayi = 0



Do Until rst.EOF



    If rst!secenek = Me.secenek Then

   

    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!evsehir & ";" & rst!evpostakodu & ";" & rst!evulke & 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!Notlar & vbCrLf

    objStream.WriteText "BDAY:" & Format(rst!dogumtarihi, "yyyy-mm-dd") & vbCrLf

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

    objStream.WriteText "CATEGORIES:" & Dlookup ("grupadi", "grup", "[id_grup]= " & rst!secenek) & vbCrLf

    objStream.WriteText "END:VCARD" & vbCrLf

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

    GSayi = GSayi + 1

    End If

    

    rst.MoveNext

    Pause 0.5

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


Cvp: Birleşik Değer Kutusuna Göre Vcard - access acemisi - 20/09/2018

Sn ozanaakkaya
DLookup İşlevi güzel oldu.Bunlara ilave olarak, Vcard düzenlemesinin yarım kalmaması için, bende şehir alanının verilerini il tablosundan almak istedim.
Tbl_kisiler tablosunda, il tablosu oluşturarak, sehir alanını da il tablosuna bağladım. Buradaki alan düzenlemesini  Vcarda uyarlamaya  çalıştım ama , burada da bir eksikliğim var galiba ki, Gmailde  rakam gözüküyor. Şehir alanının da Gmailde yazı ile gözükmesini arzu ediyorum.Saygılar
Not : Önceleri evsehir olan alan adını, sehir olarak bu dosyada yeniden adlandırdım

Cvp: Birleşik Değer Kutusuna Göre Vcard - ozanakkaya - 20/09/2018

(20/09/2018, 15:23)access acemisi yazdı: access acemisiburada da bir eksikliğim var galiba ki

Kod içerisinde iki tane CATEGORIES kullanamazsınız.


    objStream.WriteText "CATEGORIES:" & Dlookup ("grupadi", "grup", "[id_grup]= " & rst!secenek) & vbCrLf

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

Üstteki koddaki 1. satır secenek için yazılan kodlardır. 


objStream.WriteText "CATEGORIES:" & rst!secenek & vbCrLf

kodu, tablodaki secenek alanındaki verinin, grup tablosundaki grup alanı ile eşleşen kaydı bulabilmesi için 


objStream.WriteText "CATEGORIES:" & Dlookup ("grupadi", "grup", "[id_grup]= " & rst!secenek) & vbCrLf

şeklinde değiştirilmişti. Siz il için düzenleme yapacaksanız


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

kodunu düzenlemeniz gerekiyor.  rst!sehir yerine Dlookup ile il tablosundan ilgili kaydı almanız gerekli.

Konu başlığındaki sorunuz cevaplandıysa belirtin konunuzu taşıyalım. Konu başlığından farklı sorunuz var ise sorunuz ile ilgili uygun konu başlığı ile yeni konu açınız.