gmail butonundaki kodları şağıdaki kodlar ile değiştirip dener misiniz?
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
POWER 'un Çekirgesi :=)
ozguryasin,
23-09-2009 tarihinden beri
AccessTr.neT AİLESİ üyesidir.
Access'i Profesyonel Şekilde Öğrenmek İçin https://www.accesstr.net Ailesi Yeter. 
Site Kurallarını sorularınızın hızlı cevaplanması için kesinlikle okuyunuz.
