01/12/2010, 16:00
Hayri16
Değerli Arkadaşlar;
Programım da kayıt bölümünde ADO kullanıyorum. Aşağıda verdiğim sub da görüntülerini eklediğim hatayı veriyor. Forumda bir kaç arama yaptım ama çözüm bulamadım. Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.
Programım da kayıt bölümünde ADO kullanıyorum. Aşağıda verdiğim sub da görüntülerini eklediğim hatayı veriyor. Forumda bir kaç arama yaptım ama çözüm bulamadım. Yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.
Private Sub kaydet_Click() 'Kayıt bölümü
Dim yeniyol As String
Dim yenidosya As String
Dim eskiyol As String
Dim eskidosya As String
Dim a1, a2, a3, say As Integer
Dim kayyer As String
Dim kaydos As String
Dim ekle As String
Metin129 = ""
' 1- Boşluk kontrolü yap
If fkitapad = "" Or IsNull(fkitapad) Then
MsgBox ("Kitap Adını boş geçemezsiniz")
fkitapad.SetFocus
Exit Sub
End If
'Dosya hazırlık işlemleri
eskidosya = dosyaad & "." & uzanti
a1 = Len(Right(kitapseckutu.Column(1), Len(kitapseckutu.Column(1)) - InStrRev(kitapseckutu.Column(1), "\")))
a2 = Len(kitapseckutu.Column(1))
a3 = a2 - a1
eskiyol = Left(kitapseckutu.Column(1), a3)
Metin129 = eskiyol
yenidosya = fkitapad & "." & uzanti
yeniyol = CurrentProject.Path & "\" & "KITAP" & "\"
' Seçeneklere bak
If adsecim = 1 And yersecim = 1 Then 'ad değiştir, klasöre kopyala
FileCopy kitapseckutu.Column(1), yeniyol & yenidosya
kaydos = yenidosya
kayyer = yeniyol & yenidosya
'eskisini silme mesajı
ElseIf adsecim = 1 And yersecim = 2 Then 'ad değiştir , olduğu yerde bırak
FileCopy kitapseckutu.Column(1), eskiyol & yenidosya
kaydos = yenidosya
kayyer = eskiyol & yenidosya
'eskisini silme mesajı
ElseIf adsecim = 2 And yersecim = 1 Then 'ad kalsın, klasöre kopyala
FileCopy kitapseckutu.Column(1), yeniyol & eskidosya
kaydos = eskidosya
kayyer = yeniyol & eskidosya
'eskisini silme mesajı
End If
Dim rs As New ADODB.Recordset
rs.Open "F_KITAP", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'With rs
rs.AddNew
rs("kitapadi") = fkitapad
rs("yeri") = kayyer
rs("sayfa") = fsayfa
rs("edbturno") = edebiturkutu
rs("genturno") = genelturkutu
rs("altturno") = altturkutu
rs("ozturno") = ozelturkutu
'burada sorun olabilir.
If ankelliste <> "" Or ankelliste <> Null Then 'ankelliste boş değilse
For say = 0 To ankelliste.ListCount - 1
rs("ankelno" & say + 1) = ankelliste.Column(0, say)
Next
End If
rs("yayinevino") = yayevikutu
rs("basyil") = fbasyil
rs("basno") = fbassay
rs("kisakonu") = fkisakonu
rs("okunma") = oku
rs("onkapakyolu") = fonkapakyolu
rs("arkakapakyolu") = farkakapakyolu
rs("dilno") = dilkutu
rs.Update
'End With
rs.Close
'Yazar bağnatılarını yap
If secilenyazarliste <> "" Or secilenyazarliste <> Null Then 'yazar seçilmişse...
For say = 0 To secilenyazarliste.ListCount - 1
ekle = "INSERT INTO T_YAZARBAG ( kitapno, yazarno)" _
& " values(fkno,secilenyazarliste.column(0,say))"
DoCmd.RunSQL ekle
Next
End If
'Çevirmen bağlantılarını yap
If secilencevirmenliste <> "" Or secilencevirmenliste <> Null Then 'cevirmen seçilmişse...
For say = 0 To secilencevirmenliste.ListCount - 1
ekle = "INSERT INTO T_CEVIRMENBAG ( kitapno, cevirmenno)" _
& " values(fkno,secilencevirmenliste.column(0,say))"
DoCmd.RunSQL ekle
Next
End If
'Notlar bağlantılarını yap
If faciklama <> "" Or faciklama <> Null Then 'not kısmında yazı varsa
ekle = "INSERT INTO T_NOTLAR ( kitapno, aciklama)" _
& " values(fkno,'" & faciklama & "' )"
DoCmd.RunSQL ekle
End If
'geçici dosyadan sil
' Mesajı ver
MsgBox (fkitapad & " adlı kitabınızın kaydı başarıyla tamamlanmıştır")
' Ekranı temizle yeni kayda hazırla
temizle
kitapseckutu.SetFocus
End Sub