Const ForReading = 1, ForWriting = 2, ForAppending = 3

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim rst As DAO.Recordset

Dim encode As String

Dim fs, f, ts, s

Dim image_bin() As Byte

Dim VcardAdi, SoRgU As String



SoRgU = "SELECT tbl_kisiler.kisi_id, tbl_kisiler.adisoyadi, tbl_kisiler.ikinciadi, tbl_kisiler.soyadi, tbl_kisiler.sirketbilgisi, tbl_kisiler.unvani, tbl_kisiler.isunvani, tbl_kisiler.dogumtarihi, tbl_kisiler.evadresi, tbl_kisiler.evtamadres, tbl_kisiler.yer_tanimlama, tbl_kisiler.evsehir, tbl_kisiler.evbolge, tbl_kisiler.evpostakodu, tbl_kisiler.evulke, tbl_kisiler.isadresi, tbl_kisiler.issehir, tbl_kisiler.isbolge, tbl_kisiler.ispostakodu, tbl_kisiler.isulke, tbl_kisiler.evtelefonu, tbl_kisiler.Notlar, tbl_kisiler.istelefonu, tbl_kisiler.websayfasi, tbl_kisiler.ceptelefonu, tbl_kisiler.ceptelefonuiki, tbl_kisiler.ceptelesi, tbl_kisiler.telfarkli, tbl_kisiler.fax, tbl_kisiler.fotograf, tbl_kisiler.epostaadresi, tbl_kisiler.secenek, tbl_kisiler.gonderilecekler " & _

"FROM tbl_kisiler " & _

"WHERE (((tbl_kisiler.gonderilecekler)=True));"



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

    ActiveControl.Hyperlink.CreateNewDocument CurrentProject.path & "\" & VcardAdi, False, True



    Set fs = CreateObject("Scripting.FileSystemObject")

    Set f = fs.GetFile(CurrentProject.path & "\" & VcardAdi)

    

    Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)



Set rst = CurrentDb.OpenRecordset(SoRgU)

rst.MoveFirst



Me.etk_ilerle.Visible = True

Do Until rst.EOF



    ts.WriteLine "BEGIN:VCARD"

    ts.WriteLine "VERSION:3.0"

    ts.WriteLine "N:" & rst!soyadi & ";" & rst!adisoyadi & ";" & rst!ikinciadi & ";" & rst!unvani

    ts.WriteLine "FN:" & rst!adisoyadi & " " & rst!soyadi

    ts.WriteLine "ORG:" & rst!sirketbilgisi

    ts.WriteLine "TITLE:" & rst!isunvani

    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))

    ts.WriteLine "PHOTO;TYPE=JPEG;ENCODING=B:" & encode

    End If

    ts.WriteLine "TEL;WORK;VOICE:" & rst!istelefonu

    ts.WriteLine "TEL;HOME;VOICE:" & rst!evtelefonu

    ts.WriteLine "TEL;CELL;VOICE:" & rst!ceptelefonu

    ts.WriteLine "ADR;WORK:" & rst!isadresi & ";" & _

               rst!issehir & ";" & rst!ispostakodu & ";" & rst!isulke

    ts.WriteLine "ADR;HOME:" & rst!evadresi & ";" & _

                rst!evsehir & ";" & rst!evpostakodu & ";" & rst!evulke

    ts.WriteLine "X-MS-OL-DEFAULT-POSTAL-ADDRESS:1"

    ts.WriteLine "EMAIL;PREF;INTERNET:" & rst!epostaadresi

    ts.WriteLine "URL;WORK:" & rst!websayfasi

    ts.WriteLine "NOTE:" & rst!Notlar

    ts.WriteLine "BDAY:" & Format(rst!dogumtarihi, "yyyy-mm-dd")

    ts.WriteLine "REV:" & Format(Date, "yyyymmdd") & "T" & Format(Now(), "hhnnss") & "Z"

    ts.WriteLine "END:VCARD"

   

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

    

    rst.MoveNext

    Pause 0.5

Loop

Me.etk_ilerle.Visible = False

MsgBox (rst.RecordCount & " adet veri " & VcardAdi & " isimli dosyaya kaydedildi")

rst.Close



    ts.Close