• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Veritabanı olan değeri kaydetme

Katılım
15 Mayıs 2015
Mesajlar
518
Excel Vers. ve Dili
Microsoft Office 2019
Arkadaşlar!

Access olan database 1 tane tablom var

Bu kodla veri çekiyorum
Kod:
Private Sub CommandButton2_Click()
Dim con As Object, rs As Object
yol = "C:\DATA\DATA.accdb"
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [A] where kod='" & Worksheets("Veri").Range("AI8").Value & "' and sira=" & CDbl(Worksheets("Veri").Range("AU8").Value) & ";", con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next
   
    Worksheets("Veri").Range("AK14").Value = ""
    Worksheets("Veri").Range("AK15").Value = ""
    Worksheets("Veri").Range("AK16").Value = ""
    Worksheets("Veri").Range("AK17").Value = ""

    
   
    Worksheets("Veri").Range("AK14").Value = UCase(Replace(Replace(rs("marka"), "i", "İ"), "ı", "I"))
    Worksheets("Veri").Range("AK15").Value = UCase(Replace(Replace(rs("model"), "i", "İ"), "ı", "I"))
    Worksheets("Veri").Range("AK16").Value = UCase(Replace(Replace(rs("seri"), "i", "İ"), "ı", "I"))
    Worksheets("Veri").Range("AK17").Value = UCase(Replace(Replace(rs("musterino"), "i", "İ"), "ı", "I"))
End If
    
rs.Close
con.Close




Set rs = Nothing: Set con = Nothing


' KAYDET BUTTON AKTİFLEŞTİRMESİ
CommandButton3.Enabled = False
CommandButton3.BackColor = RGB(255, 255, 255)
End Sub


Eğer aradığım kod ve sıra değeri yoksa aşağıdaki kodla kaydediyorum

Kod:
Private Sub CommandButton9_Click()
Dim conn2 As Object, rs2 As Object
If Worksheets("Veri").Range("AI8").Value = "" Then
    MsgBox "KOD boş olamaz." & vbLf & "Giriş iptal oldu!", vbCritical, "U Y A R I"
    Exit Sub
End If
yol = "C:\DATA\DATA.accdb"
Set conn2 = CreateObject("adodb.connection")
Set rs2 = CreateObject("adodb.recordset")
conn2.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs2.Open "select * from [A] ;", conn2, 1, 3
rs2.addnew
rs2("kod").Value = Worksheets("Veri").Range("AI8").Value
rs2("sira").Value = Worksheets("Veri").Range("Au8").Value
rs2("marka").Value = Worksheets("Veri").Range("AK14").Value
rs2("model").Value = Worksheets("Veri").Range("AK15").Value
rs2("seri").Value = Worksheets("Veri").Range("AK16").Value
rs2("musterino").Value = Worksheets("Veri").Range("AK17").Value

rs2.Update
rs2.Close: conn2.Close
Set rs2 = Nothing: Set conn2 = Nothing

MsgBox "Veriler girildi."



End Sub


sorum şu : örnekle

ANU ve 223 diye sorguluyorum


Marka : TEKS
Model : PA12589L
Seri :
Müşteri No : 12546


Seri numarası boş çıkıyor mesala.

Seri numarayı elimle yazıyorum kaydet dediğimde aynı kod ve sira numarası ile yeni bi kayıt oluşuyor.

Birdahaki arattığımda seri boş olan kayıtı buluyor.


Ben var olan kayıt numarasını değiştirmesini istiyorum

Yardımlarınızı bekliyorum
 
Son düzenleme:
bu kodu buldum. Değiştirme yardımcı olsanız ?

Kod:
 Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim strConn As String

   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"

   Set myRecordset = New ADODB.Recordset

   With myRecordset
      .Open "Select * from Employees Where LastName = 'Marco'", _
         strConn, adOpenKeyset, adLockOptimistic
      .Fields("FirstName").Value = "A"
      .Fields("City").Value = "D"
      .Fields("Country").Value = "USA"
      .Update
      .Close
   End With
   Set myRecordset = Nothing
   Set conn = Nothing

Ama bu fiels komutları var

Bendekiler rs komutları.

Değiştirdim çalışmadı

Kod:
Dim con As Object, rs As Object
yol = "C:\DATA\DATA.accdb"
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & yol & ""
rs.Open "select * from [A] where kod='" & Worksheets("Veri").Range("AI8").Value & "' and sira=" & CDbl(Worksheets("Veri").Range("AU8").Value) & ";", con, 1, 1
If rs.RecordCount > 0 Then
 On Error Resume Next


rs("marka").Value = Worksheets("Veri").Range("AK14").Value
rs("model").Value = Worksheets("Veri").Range("AK15").Value
rs("seri").Value = Worksheets("Veri").Range("AK16").Value
rs("musterino").Value = Worksheets("Veri").Range("AK17").Value
  rs.Update
rs.Close: con.Close
Set rs = Nothing: Set con = Nothing

MsgBox "Veriler girildi."

bu hatayı aldım

Kod:
Geçerli Kayıt Dizisi güncelleştirmeyi desteklemiyor. Bu, sağlayıcının veya seçili kilit türünün bir sınırlaması olabilir

Burdan yardımcı olabilirsiniz
 
Son düzenleme:
Kod:
conn2, 1, 3

Değiştirince düzeldi . TEŞEKKÜRLER
 
Geri
Üst